프로그램
캐드 분류

오스냅관련 리습 수정방법 부탁드립니다.

컨텐츠 정보

본문

안녕하세요.

트림 리습입니다.
리습 파일 수정하고자 글올렸습니다. 실행하고 나면 오스냅이 풀려서 수정방법 부탁드려요.
;
;자동트림 – 라인,폴리라인,원,아크
;
(defun C:AT(/ ent entl ent-p ent-name ent-length ent-length2 ent-ptlist ents-t ents)
  (vl-load-com)
    (setq osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (setq ent (entsel "n 잘라낼 객체를 선택 하세요 :"))
 (while (/= cadr ENT nil) 
  (setq ent-p (car (cdr ent)))
  (setq entl (entget (car ent)))
  (setq ent-name (cdr (assoc 0 entl)))
  (command "Lengthen" ent "")
  (setq ent-length (getvar "PERIMETER"))
  (cond
    ((= ent-name "LWPOLYLINE")(setq ent-ptlist (getpolyvtx entl)))
    ((= ent-name "LINE")      (setq ent-ptlist (list (cdr (assoc 10 entl)) (cdr (assoc 11 entl)))))
    ((= ent-name "ARC")       (tt-sub_arc2 (car ent)))
    ((= ent-name "CIRCLE")    (tt-sub_arc2 (car ent)))
    (T (prompt "nt [안내] 라인,폴리라인,원,아크가 아닙니다 !! :"))
  );cond
  (if ent-ptlist
    (progn
      (setq ents-t (ssget "F" ent-ptlist))
      (command "Trim" ents-t "" ent-p "")
      (if ent
        (progn
          (command "Lengthen" ent "")
          (setq ent-length2 (getvar "PERIMETER"))
          (if (= ent-length ent-length2)
            (command "Erase" ent "")
          );if
        );progn
      );if
    );progn
  );if
 (setq ENT (entsel "n 다음 객체를 선택하세요(취소는…ESC 또는 빈공간 선택) :"))
 ); while
   (setvar "osmode" 32)
 (princ)
);defun
(defun tt-sub_arc2 (ename)
  (setq obj (vlax-ename->vla-object ename))
  (setq obj-st (vlax-curve-getStartParam obj))
  (setq obj-ed (vlax-curve-getEndParam obj))
  (setq d (/ ent-length 20)) ; 선택한것의 길이를 20으로 나누어서 포인트를 등분.
  (setq ix 1)
  (setq ent-ptlist nil ent-ptlist (list (vlax-curve-getStartPoint obj)))
  (repeat 20
      (setq ent-ptlist (append ent-ptlist (list (vlax-curve-getPointAtDist obj (* d ix)))))
      (setq ix (1+ ix))
  );repeat
  (setq ename (vlax-vla-object->ename obj))
);defun  
(defun GetPolyVtx(EntList / VtxList AA X)
  (setq VtxList '())
  (IF (= "LWPOLYLINE" (CDR (ASSOC 0 EntList)))
   (mapcar '(lambda (x) (if (= 10 (car x)) (setq VtxList (append VtxList (list (cdr x))) ) ) ) EntList)
   (PROGN
    (SETQ AA (ENTGET(ENTNEXT (CDR (ASSOC -1 EntList)))))
    (WHILE (/= "SEQEND" (CDR (ASSOC 0 AA)))
      (setq VtxList (append VtxList (list (cdr (ASSOC 10 AA)))))
      (SETQ AA (ENTGET(ENTNEXT (CDR (ASSOC -1 AA)))))
    );while
  );progn
  );if
  VtxList
 );defun

관련자료

댓글 2 / 1 페이지
전체 63 / 1 페이지
번호
제목
이름
알림 0