캐드 분류
LISP 을 하면 반응이 없습니다.
컨텐츠 정보
- 175 조회
- 0 추천
- 0 비추천
- 목록
본문
어떤 도면에는 작동하고 어떤 도면에는 리습이 작동하지 않는것 같습니다.
아니라면 처음 한번은 작동하는데 그 후부터는 반응이 없습니다.
왜 그런지 당최 알 수가 없습니다 ㅠㅠ..
캐드 설정을 잘 못 건드린건지.. 흠.. 잘 모르겠네요..
리습 내용은 아래와 같은데요.. 쓰는 버전은 2010버전이구요.
아마 2004에서는 잘 작동한 것 같습니다.
왜 작동이 안되는지 가르쳐 주시면 감사하겠습니다. ㅠㅠ
;;; Find the dotted pairs that are valid filters for ssget
;;; in entity named "ent".
;;;
;;; ssx_fe == SSX_Find_Entity
;;;
(defun ssx_fe (/ x data fltr ent)
(setq ent (car (entsel "nSelect object/: ")))
(if ent
(progn
(setq data (entget ent))
(foreach x '(0 2 6 7 8 39 62 66 210) ; do not include 38
(if (assoc x data)
(setq fltr
(cons (assoc x data) fltr)
)
)
)
(reverse fltr)
)
)
)
;;;
;;; Remove "element" from "alist".
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
(append
(reverse (cdr (member element (reverse alist))))
(cdr (member element alist))
)
)
;;;
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s) ; If an error (such as CTRL-C) occurs
; while this command is active…
(if (/= s "Function cancelled")
(princ (strcat "nError: " s))
)
(if olderr (setq *error* olderr)) ; Restore old *error* handler
(princ)
)
;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr)
(gc) ; close any sel-sets
(setq olderr *error*
*error* ssx_er
)
(setq fltr (ssx_fe))
(ssx_gf fltr)
)
;;;
;;; Build the filter list up by picking, selecting an item to add,
;;; or remove an item from the list by selecting it and pressing RETURN.
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
(defun ssx_gf (f1 / t1 t2 t3 f1 f2)
(while
(progn
(cond (f1 (prompt "nFilter: ") (prin1 f1)))
(initget
"Block Color Entity Flag LAyer LType Pick Style Thickness Vector")
(setq t1 (getkword (strcat
"n>>Block name/Color/Entity/Flag/"
"LAyer/LType/Pick/Style/Thickness/Vector: ")))
)
(setq t2
(cond
((eq t1 "Block") 2) ((eq t1 "Color") 62)
((eq t1 "Entity") 0) ((eq t1 "LAyer") 8)
((eq t1 "LType") 6) ((eq t1 "Style") 7)
((eq t1 "Thickness") 39) ((eq t1 "Flag" ) 66)
((eq t1 "Vector") 210)
(T t1)
)
)
(setq t3
(cond
((= t2 2) (getstring "n>>Block name to add/: "))
((= t2 62) (initget 4 "?")
(cond
((or (eq (setq t3 (getint
"n>>Color number to add/?/: ")) "?")
(> t3 256))
(ssx_pc) ; Print color values.
nil
)
(T
t3 ; Return t3.
)
)
)
((= t2 0) (getstring "n>>Entity type to add/: "))
((= t2 8) (getstring "n>>Layer name to add/: "))
((= t2 6) (getstring "n>>Linetype name to add/: "))
((= t2 7)
(getstring "n>>Text style name to add/: ")
)
((= t2 39) (getreal "n>>Thickness to add/: "))
((= t2 66) (if (assoc 66 f1) nil 1))
((= t2 210)
(getpoint "n>>Extrusion Vector to add/: ")
)
(T nil)
)
)
(cond
((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; get entity
((and f1 (assoc t2 f1)) ; already in the list
(if (and t3 (/= t3 ""))
;; Replace with a new value…
(setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
;; Remove it from filter list…
(setq f1 (ssx_re (assoc t2 f1) f1))
)
)
((and t3 (/= t3 ""))
(setq f1 (cons (cons t2 t3) f1))
)
(T nil)
)
)
(if f1 (setq f2 (ssget "_x" f1)))
(setq *error* olderr)
(if (and f1 f2)
(progn
(princ (strcat "n" (itoa (sslength f2)) " found. "))
f2
)
(progn (princ "n0 found.") (prin1))
)
)
;;;
;;; Print the standard color assignments.
;;;
;;;
(defun ssx_pc ()
(if textpage (textpage) (textscr))
(princ "n ")
(princ "n Color number | Standard meaning ")
(princ "n ________________|____________________")
(princ "n | ")
(princ "n 0 | ")
(princ "n 1 | Red ")
(princ "n 2 | Yellow ")
(princ "n 3 | Green ")
(princ "n 4 | Cyan ")
(princ "n 5 | Blue ")
(princ "n 6 | Magenta ")
(princ "n 7 | White ")
(princ "n 8…255 | -Varies- ")
(princ "n 256 | ")
(princ "n nnn")
)
;;;
;;; C: function definition.
;;;
(defun c:ssx () (ssx)(princ))
(princ "ntType "ssx" at a Command: prompt or ")
(princ "nt(ssx) at any object selection prompt. ")
(princ)
관련자료
댓글 0
/ 1 페이지
등록된 댓글이 없습니다.
