캐드 분류
양쪽선 남기기 리습 수정 부탁드립니다.
컨텐츠 정보
- 83 조회
- 2 댓글
- 0 추천
- 0 비추천
- 목록
본문
안녕하세요?
리습에는 완전 무뇌한 사람입니다.ㅠ
다른분들이 잘 만들어 주신 리습으로 몇개 사용중인데요..
이리습은 양쪽 선 남기는건데 오른쪽만 남아요 ㅠ 기존선은 그대로 두고 양쪽선 원하는 길이로 남기고 싶은데 수정 가능할까요?
제발 부탁 드립니다.
(defun c:qt( / sl-mapcar-ens ss)
(vl-load-com)
(prompt "n>> 색상을 변경할 객체를 선택하세요… ")
(setq ss (ssget))
(command "change" ss "" "p" "c" "2″ "")
(prompt (strcat "n>> 2번 색상으로 변경되었습니다." ))
(defun sl-mapcar-ens (func ss) (mapcar func (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(princ "n선 양끝 남기기")
(and
(or *dis* (setq *dis* 50))
(setq *dis* (cond ((getdist (strcat "n남길 길이 입력 <" (vl-princ-to-string *dis*) ">:"))) (*dis*)))
(sl-mapcar-ens
'(lambda (en / ent1 len ep ent2 sp)
(setq ent1 (entget en) len (vlax-curve-getdistatparam en (vlax-curve-getendparam en)))
(if (> len *dis*)
(progn
(setq ep (vlax-curve-getpointatdist en *dis*) sp (vlax-curve-getpointatdist en (- len *dis*)))
(setq nen (entmakex (vl-remove '(lambda (-1 5)) (entget en))) ent2 (entget nen))
(entmod (subst (cons 10 sp) (assoc 10 ent1) ent1))
(entmod (subst (cons 11 ep) (assoc 11 ent2) ent2))
(entmod (subst (cons 62 7) (assoc 62 ent2) ent2))
)
(princ "n입력한 길이보다 선이 짧습니다.")
)
)
ss
)
)
(princ)
)
;;;
관련자료
댓글 2
/ 1 페이지
