블럭간 연결하는 리습 에러..
컨텐츠 정보
- 810 조회
- 0 추천
- 0 비추천
-
목록
본문
블럭간 연결선 그리는 리습으로 캐드2008에서 사용하던 리습입니다…..
2008에서는 잘 사용했는데 캐드2016에서 리습 실행중….다음과 같은 에러가 나네요…
VVC: Internal Error
캐드버전이 높아지면서 발생하는 에러같은데 수정 부탁 드립니다….^^
——————————————————————————————————————————-
(defun c:bb
( / spc objs objx objy typ
_ObjectsAsExplode
_DivideLst
_Explode
_Parallel-p
_Objects
_Apply
_DivideLst
_Doc
_sortAngObj
_m*v
_GetParams
_data
_Start
_End
*error*
)
(command "color" "4″)
(if (tblsearch "layer" "wire")
(command "layer" "s" "wire" "")
(progn
(command "layer" "new" "wire" "color" "4″ "wire" "")
(command "layer" "s" "wire" "")
)
)
(defun *error* (s) (_End nil) (princ s))
(defun _start( lst / doc )
(setq doc (_end nil))
(vla-startundomark doc)
(list lst (mapcar 'getvar lst))
)
(defun _end ( d / doc )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(and (cadr d) (mapcar 'setvar (car d) (cadr d)))
(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark doc)) doc
)
(defun _GetParams ( oBase block / objs r lst nBlock )
(setq nBlock (vla-copy block))
(foreach o (setq objs (_ObjectsAsExplode nblock nil))
(cond
( (and
(setq lst (_Apply 'vlax-invoke (list oBase 'IntersectWith o acExtendNone)))
(vl-consp lst)
(setq lst (_DivideLst lst 3))
)
(foreach l lst
(setq r (cons (vlax-curve-getParamAtPoint oBase (vlax-curve-getClosestPointTo oBase l)) r))
)
)
( (and
(wcmatch (vla-get-objectname o) "AcDbPolyline,AcDbLine")
(_Parallel-p oBase o)
)
(mapcar
'(lambda ( p1 / p2 )
(if (equal 0. (distance p1 (setq p2 (vlax-curve-getclosestpointto oBase p1))) 1e-04)
(setq r (cons (vlax-curve-getParamAtPoint oBase p2) r))
)
)
(list (vlax-curve-getstartpoint o) (vlax-curve-getendpoint o))
)
)
)
) (mapcar 'vla-delete objs)
(vl-sort r '<)
)
(defun _data ( o / mi ma )
(vla-getboundingbox o 'mi 'ma)
(setq ma (vlax-safearray->list ma) mi (vlax-safearray->list mi))
(list
(* 0.1(- (cadr ma) (cadr mi)))
(mapcar '(lambda ( a b ) (* (+ a b) 0.5)) mi ma)
)
)
(defun _ObjectsAsExplode ( obj f / lst )
(if (setq lst (_Explode obj))
(vl-remove nil
(apply 'append
(mapcar
'(lambda ( o / os )
(if
(member
(vla-get-objectname o)
(if f '("AcDbBlockReference" "AcDbPolyline") '("AcDbBlockReference"))
)
(setq os (_ObjectsAsExplode o f))
(list o)
)
) lst
)
)
)
)
)
(defun _Parallel-p ( o1 o2 / p1 p2 p3 p4 _sin )
(defun _sin ( a b ) (abs (sin (angle a b))))
(and
(null (vlax-invoke o1 'IntersectWith o2 acExtendBoth))
(setq p1 (vlax-curve-getstartpoint o1)
p2 (vlax-curve-getendpoint o1)
p3 (vlax-curve-getstartpoint o2)
p4 (vlax-curve-getendpoint o2)
)
(equal (_sin p1 p2) (_sin p3 p4) 1e-04)
(equal (_sin p1 p3) (_sin p1 p4) 1e-04)
(equal (_sin p2 p3) (_sin p2 p4) 1e-04)
)
)
(defun _Explode ( o / __Explode )
(defun __Explode ( o / a b d e )
(setq e (vlax-vla-object->ename o)
a (entlast)
)
(and
(_Apply 'vl-cmdf (list "_.explode" e))
(setq b (ssget "p"))
(null (equal a (entlast)))
(setq d (_Objects b))
) d
)
(_Apply '__Explode (list o))
)
(defun _Apply ( fun lst / r )
(if
(vl-catch-all-error-p
(setq r (vl-catch-all-apply fun lst))
)
(setq r nil)
(or r (setq r t))
) r
)
(defun _objects ( ss / i re )
(if ss
(repeat (setq i (sslength ss))
(setq re (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) re))
)
)
)
(defun _DivideLst ( l n / r)
(if l
(cons
(reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
(_DivideLst l n)
)
)
)
(defun _Doc ( ^doc ^spc / doc^ )
(setq doc^ (vla-get-activedocument (vlax-get-acad-object)))
(if ^spc
(set ^spc
(vlax-get-property doc^
(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
)
)
) (if ^doc (set ^doc doc^))
)
(defun _sortAngObj
( olst typ tol ang /
typ objs opt npt lst data lst rev sx sy dxf x y
_s1 _s2 _s3 _s4
)
(defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
(defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
(defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
(defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o)))))
(defun x (o)
(car
(_m*v
(list
(list (cos ang) (- (sin ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
(trans (dxf o 10) (dxf o 210) 0)
)
)
)
(defun y (o)
(cadr
(_m*v
(list
(list (cos ang) (- (sin ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
(trans (dxf o 10) (dxf o 210) 0)
)
)
)
(setvar 'CMDECHO 0)
(setq typ (vl-string->list (strcase typ))
ang (- ang)
)
(if (minusp (cos ang)) (setq ang (+ ang pi)))
(if (member (car typ) '(76 82))
(setq _s1 sy _s2 y _s3 sx _s4 rev)
(setq _s1 sx _s2 x _s3 sy _s4 rev)
)
(setq objs (_s1 olst) opt (_s2 (car objs)))
(foreach o objs
(if (< tol (abs (- (setq npt (_s2 o)) opt)))
(setq lst (cons data lst) data (list o) opt npt)
(setq data (cons o data))
)
)
(setq lst (mapcar '(lambda (l) (_s3 l))(cons data lst))
lst (if (member (cadr typ) '(85 82)) (reverse lst) lst)
lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst)
lst (if (/= (car typ) (caddr typ))(_s4 lst t) lst)
)
)
(defun _m*v ( m v )
(mapcar '(lambda ( m ) (apply '+ (mapcar '* v m))) m)
)
(_Doc nil 'spc)
(if
(and
(setq objs (_Objects (ssget "_:L" '((0 . "insert")))))
(progn
(initget "X Y")
(setq typ (getangle "nSpecify Angle < X or Y > : "))
)
)
(progn
(cond
( (= typ "X")
(setq objs (_SortAngObj objs "rdr" (car (_data (car objs))) 0.))
)
( (= typ "Y")
(setq objs (_SortAngObj objs "drd" (car (_data (car objs))) 0.))
)
( t
(setq objs (_SortAngObj objs "rdr" (car (_data (car objs))) typ))
)
)
(_Start nil)
(mapcar
'(lambda ( os / oLine )
(setq oLine
(vlax-invoke spc 'addline
(cadr (_data (car os)))
(cadr (_data (last os)))
)
)
(mapcar
'(lambda ( o1 o2 / p1 p2 )
(setq p1 (last (_GetParams oLine o1))
p2 (car (_GetParams oLine o2))
)
(if (and p1 p2)
(vlax-invoke spc 'addline
(vlax-curve-GetpointAtParam oLine p1)
(vlax-curve-GetpointAtParam oLine p2)
)
)
) os (cdr os)
) (vla-delete oLine)
) objs
)
(_End nil)
)
)(princ)
)(vl-load-com)