캐드 분류
Textcount 와 색상객체선택 리습 합치기 도움요청
컨텐츠 정보
- 1,415 조회
- 0 추천
- 0 비추천
-
목록
본문
며칠 전 도움 잘받았는데 추가로 필요한 부분 있어 또 도움 요청 해봅니다.
2가지 리습을 합쳐서 사용하고 싶은데 어떻게 수정을 해야 할 지 모르겠습니다.
능력 되시는 분 수정 문구 알려 주시면 감사 하겠습니다.
1. textcount.lsp (문자 카운트 리습)
2. ss1(색상으로 객체 선택 리습)
위 두개 합쳐서 지정 칼라 문자만 선택해서 각문자별 수량 카운트 결과을 얻고 싶습니다.
* 리습 내용 2가지는 입니다. 명령어 TC하고 SS1입니다. (리습 내용이 꽤 길어요…. )
;;——————–=={ Text Count }==———————-;;
(defun c:tc( / *error*_StartUndo_EndUndo_Assoc++_SumAttributes_GetTextString_ApplyFooToSelSet
acdoc
acspc
alist
data
pt
)
(vl-load-com)
;;————————————————————;;
(defun *error* ( msg )
(if acdoc (_EndUndo acdoc))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "n** Error: " msg " **"))
)
(princ)
)
;;————————————————————;;
(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)
;;————————————————————;;
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
;;————————————————————;;
(defun _Assoc++ ( key alist )
(
(lambda ( pair )
(if pair
(subst (list key (1+ (cadr pair))) pair alist)
(cons (list key 1) alist)
)
)
(assoc key alist)
)
)
;;————————————————————;;
(defun _SumAttributes ( entity alist )
(while
(not
(eq "SEQEND"
(cdr
(assoc 0
(entget
(setq entity (entnext entity))
)
)
)
)
)
(setq alist (_Assoc++ (_GetTextString entity) alist))
)
)
;;————————————————————;;
(defun _GetTextString ( entity )
(
(lambda ( string )
(mapcar
(function
(lambda ( pair )
(if (member (car pair) '(1 3))
(setq string (strcat string (cdr pair)))
)
)
)
(entget entity)
)
string
)
""
)
)
;;————————————————————;;
(defun _ApplyFooToSelSet ( foo ss / i )
(if ss (repeat (setq i (sslength ss)) (foo (ssname ss (setq i (1- i))))))
)
;;————————————————————;;
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
(princ "nCurrent Layer Locked.")
)
( (not (vlax-method-applicable-p acspc 'AddTable))
(princ "nTable Object not Available in this version.")
)
( (and
(setq data
(_ApplyFooToSelSet
(lambda ( entity / typ )
(setq alist
(cond
( (eq "INSERT" (setq typ (cdr (assoc 0 (entget entity)))))
(_SumAttributes entity alist)
)
( (eq "MULTILEADER" typ)
(_Assoc++ (cdr (assoc 304 (entget entity))) alist)
)
( (wcmatch typ "*DIMENSION")
(_Assoc++ (cdr (assoc 1 (entget entity))) alist)
)
( (_Assoc++ (_GetTextString entity) alist) )
)
)
)
(ssget
'(
(-4 . " (0 . "TEXT,MTEXT,MULTILEADER")
(-4 . " (0 . "INSERT")
(66 . 1)
(-4 . "AND>")
(-4 . " (0 . "*DIMENSION")
(1 . "*?*")
(-4 . "AND>")
(-4 . "OR>")
)
)
)
)
(setq pt (getpoint "nSpecify Point for Table: "))
)
(_StartUndo acdoc)
(LM:AddTable acspc (trans pt 1 0) "String Count"
(cons (list "String" "Instances")
(vl-sort
(mapcar
(function
(lambda ( x ) (list (car x) (itoa (cadr x))))
)
data
)
(function (lambda ( a b ) (< (car a) (car b))))
)
)
)
(_EndUndo acdoc)
)
)
(princ)
)
;;———————=={ Add Table }==———————-;;
;; ;;
;; Creates a VLA Table Object at the specified point, ;;
;; populated with title and data ;;
;;————————————————————;;
;; Author: Lee Mac, Copyright ?2011 – http://www.lee-mac.com ;;
;;————————————————————;;
;; Arguments: ;;
;; space – VLA Block Object ;;
;; pt – Insertion Point for Table ;;
;; title – Table title ;;
;; data – List of data to populate the table ;;
;;————————————————————;;
;; Returns: VLA Table Object ;;
;;————————————————————;;
(defun LM:AddTable ( space pt title data / _isAnnotative textheight style )
(defun _isAnnotative ( style / object annotx )
(and
(setq object (tblobjname "STYLE" style))
(setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
(= 1 (cdr (assoc 1070 (reverse annotx))))
)
)
(
(lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText table row (setq column (1+ column)) item)
)
)
rowitem
)
)
-1
)
)
)
data
)
)
0
)
table
)
(
(lambda ( textheight )
(vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) textheight
(* 0.8 textheight
(apply 'max
(cons (/ (strlen title) (length (car data)))
(mapcar 'strlen (apply 'append data))
)
)
)
)
)
(* 2.
(/
(setq textheight
(vla-gettextheight
(setq style
(vla-item
(vla-item
(vla-get-dictionaries (vla-get-document space)) "ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
)
acdatarow
)
)
(if (_isAnnotative (vla-gettextstyle style acdatarow))
(cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 ))
1.0
)
)
)
)
)
)
;;————————————————————;;
;; End of File ;;
;;————————————————————;;
(defun c:ss1(/ entdata entcolour colour layer layerlist layercolourlist layernamefilter strlayer strlayerlen filter)
(setq entdata (entget (car (entsel "nPls select object color."))))
(if (setq entcolour (cdr (assoc 62 entdata)))
(setq colour entcolour)
(setq colour (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entdata))))))
)
(setq layer (tblnext "layer" T))
(while layer
(setq layerlist (append layerlist (list layer)))
(setq layer (tblnext "layer"))
)
(while layerlist
(if
(/= colour (cdr (assoc 62 (nth 0 layerlist))))
(setq layerlist (cdr layerlist))
(progn
(setq layercolourlist (append (list (cdr (assoc 2 (nth 0 layerlist)))) layercolourlist))
(setq layerlist (cdr layerlist))
)
)
)
(if (= layercolourlist nil)
(setq filter (list (cons 62 colour) (cons -4 "")))
(progn
(setq strlayer "")
(while (car layercolourlist)
(setq strlayer (strcat strlayer (car layercolourlist) ","))
(setq layercolourlist (cdr layercolourlist))
)
(setq strlayerlen (strlen strlayer))
(setq layernamefilter (substr strlayer 1 (1- strlayerlen)))
(setq filter (list (cons -4 "") (cons 62 colour) (cons -4 "or>") (cons -4 "")))
)
)
(prompt "nPls select object.")
(sssetfirst nil (ssget filter))
(princ)
)
관련자료
댓글 0
/ 1 페이지
등록된 댓글이 없습니다.
