프로그램
캐드 분류

블럭간 연결하는 리습 에러..

컨텐츠 정보

본문

블럭간 연결선 그리는 리습으로 캐드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)

관련자료

댓글 0 / 1 페이지
등록된 댓글이 없습니다.
전체 101 / 4 페이지
RSS
번호
제목
이름

최근글


새댓글


알림 0