Message 1 of 3

Not applicable
08-25-2019
08:10 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
hello. good morning. Lisp runs, The result is output. and I want to write the result in dwg.
(command "text" (getpoint) "" "" ??? <--- I want to add this sentence. I need help
;;;
;;; Get info on all objs Inside a Polyline
;;;
(defun C:GIP (/ objSel PolyName)
(setq objSel nil)
(while (= objSel nil)
(setq objSel (vlax-ename->vla-object
(car (nentsel "\nSelect Polyline: "))
)
)
)
;; Check it is closed.
(if (not (vlax-curve-isClosed objSel))
(progn
(princ "\nIt must be a closed Polyline. Exiting.")
(exit)
)
)
(if (not (vlax-curve-isClosed objSel))
(progn
(princ "\nIt must be a closed Polyline. Exiting.")
(exit)
)
)
(setq PolyName (vla-get-ObjectName objSel))
(if (wcmatch PolyName "AcDb*Polyline")
(FindCount objSel)
)
)
(defun FindCount (obj / plist ss i)
(setq plist (agroup (vlax-get obj "Coordinates")))
(setq ss nil)
(setq blks (ssadd)
txts (ssadd)
anyOther (ssadd)
(setq plist (agroup (vlax-get obj "Coordinates")))
(setq ss nil)
(setq blks (ssadd)
txts (ssadd)
anyOther (ssadd)
)
;; Acad gently selects all objs inside the polyline by us!!
(setq ss (ssget "_WP" plist))
(setq ss (ssget "_WP" plist))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq ename (ssname ss i))
(setq entList (entget ename))
(setq ename (ssname ss i))
(setq entList (entget ename))
(cond ((= (cdr (assoc 0 entList)) "INSERT")
(setq blks (ssadd ename blks))
)
((= (cdr (assoc 0 entList)) "TEXT")
(setq txts (ssadd ename txts))
)
((= (cdr (assoc 0 entList)) "MTEXT")
(setq txts (ssadd ename txts))
)
(T (setq anyOther (ssadd ename anyOther)))
)
(setq blks (ssadd ename blks))
)
((= (cdr (assoc 0 entList)) "TEXT")
(setq txts (ssadd ename txts))
)
((= (cdr (assoc 0 entList)) "MTEXT")
(setq txts (ssadd ename txts))
)
(T (setq anyOther (ssadd ename anyOther)))
)
)
;; Process by group of entities
(setq blkRes (fun1 blks 2)) ; blk, names
(setq txtRes (fun1 txts 1)) ; text, texts
(setq anyRes (fun1 anyOther 62)) ; any, color.
(setq blkRes (fun1 blks 2)) ; blk, names
(setq txtRes (fun1 txts 1)) ; text, texts
(setq anyRes (fun1 anyOther 62)) ; any, color.
;; Take this list for any further extension of this program
(setq resList (list (cons 1 blkRes) ; blks
(cons 2 txtRes) ; txts
(cons 3 anyRes) ; anys
)
)
(setq resList (list (cons 1 blkRes) ; blks
(cons 2 txtRes) ; txts
(cons 3 anyRes) ; anys
)
)
(foreach n resList
(fun2 n (car n))
)
(fun2 n (car n))
)
(princ)
) ;_ defun
(defun fun1 (ss assocKey / i T_Entity propList propName)
(setq propList nil)
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq T_Entity (ssname ss i))
(setq T_Entity (ssname ss i))
(setq propList (if (not (assoc (setq propName
(cdr (assoc
assocKey
(entget
T_Entity
)
)
)
)
proplist
)
)
(append
proplist
(list (list propName 1))
)
(subst
(list
propName
(1+ (cadr (assoc
propName
proplist
)
)
)
)
(assoc propName
proplist
)
proplist
)
)
)
)
)
(cdr (assoc
assocKey
(entget
T_Entity
)
)
)
)
proplist
)
)
(append
proplist
(list (list propName 1))
)
(subst
(list
propName
(1+ (cadr (assoc
propName
proplist
)
)
)
)
(assoc propName
proplist
)
proplist
)
)
)
)
)
(defun fun2 (l key)
(cond ((= key 1) (setq ent "Blocks"))
((= key 2) (setq ent "Texts"))
((= key 3) (setq ent "Other Objects"))
(T "Unknown")
)
((= key 2) (setq ent "Texts"))
((= key 3) (setq ent "Other Objects"))
(T "Unknown")
)
(princ (strcat "\n ** Total number of "
ent
" found: "
(itoa (SumAll (cdr l)))
)
)
ent
" found: "
(itoa (SumAll (cdr l)))
)
)
(PrintThem (cdr l))
)
)
;;;;;; helpers ;;;;;;;;
(defun PrintThem (l)
(foreach n
(vl-sort
l
'(lambda (e1 e2)
(< (car e1) (car e2))
)
)
(princ
(strcat
"\n"
(cond ((not (car n)) "Bylayer")
((= (car n) 0) "Byblock")
((= (type (car n)) 'INT) (getColorName (car n)))
(T (car n))
)
": "
(itoa (cadr n))
) ;_ strcat
)
)
)
(foreach n
(vl-sort
l
'(lambda (e1 e2)
(< (car e1) (car e2))
)
)
(princ
(strcat
"\n"
(cond ((not (car n)) "Bylayer")
((= (car n) 0) "Byblock")
((= (type (car n)) 'INT) (getColorName (car n)))
(T (car n))
)
": "
(itoa (cadr n))
) ;_ strcat
)
)
)
(defun getColorName (i)
(cond ((= i 1) "Red")
((= i 2) "Yellow")
((= i 3) "Green")
((= i 4) "Cyan")
((= i 5) "Blue")
((= i 6) "Magenta")
((= i 7) "White")
(T (itoa i))
)
)
(cond ((= i 1) "Red")
((= i 2) "Yellow")
((= i 3) "Green")
((= i 4) "Cyan")
((= i 5) "Blue")
((= i 6) "Magenta")
((= i 7) "White")
(T (itoa i))
)
)
(defun SumAll (l)
(apply '+
(mapcar
'(lambda (x)
(cadr x)
)
l
)
)
)
(apply '+
(mapcar
'(lambda (x)
(cadr x)
)
l
)
)
)
(defun agroup (l)
(if l
(cons (list (car l) (cadr l)) (agroup (cddr l)))
)
)
(if l
(cons (list (car l) (cadr l)) (agroup (cddr l)))
)
)
;|≪Visual LISPⓒ Format Options≫
(72 4 12 2 nil "_" 60 12 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;
(72 4 12 2 nil "_" 60 12 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;
Solved! Go to Solution.