;| 25-11-2020
Point or Circle Closest To Text CC2TNEZ
change text to mtext for 3D coordinate
add table Z ( elevations)
|;
(defun
c:cc2tz ( / points texts i j pt ind dst d result)
(setq
old_cmdecho (getvar
"cmdecho"))
(setvar
"cmdecho" 0)
(setq txtH (getvar "TEXTSIZE"))
(setq txtS (getvar
"textstyle"))
(initget
"1 2 3")
(setq opt (getkword "\nSelect
Options : \n [1 Pick points. / 2 Select object. / 3 Find All. ] <1> "))
(if (= opt "")(setq opt
"1"))
(if
(or(= opt "1")(= opt "2"))
(progn
;;-----------Enter
String Symbol -----
(if (null sta)(setq sta "A"))
(setq statemp (getstring (strcat "\n
Enter String Symbol <" sta
">: ")))
(if (eq statemp "")
(setq statemp sta)
(setq sta statemp)
)
;;----------Number
Start Count--------
(or nma (setq nma 1))
(setq nmatemp
(getDist (strcat "\nEnter
Number : <"
(rtos nma 2 0)
">: "
) ;_ strcat
) ;_ getdist
) ;_ setq
(and nmatemp (setq nma nmatemp))
);;progn
);;if
;;------------------------------------
(if
(= opt "1")
(progn
(while(setq pt (getpoint "\nPick
Points :"))
(setq txt (strcat " "
(strcase sta) (rtos nma 2 0)))
(metxt pt 7 txth 0 txt)
(setq result
(append result
(list
(list
txt ;;
text
(car
pt) ;; x value of point
(cadr
pt) ;; y value of point
(caddr
pt) ;; z value of point
)
)
)
)
(setq nma (1+ nma))
)
(setq lst1 result)
)
);if
= Pick points
;;-----------------------------
(if
(= opt "2")
(progn
(princ "\n Select circle
mark.")
(if (setq ss (ssget '((0 .
"POINT,CIRCLE"))))
(progn
(setq ctr 0
numss (sslength ss)
)
(repeat (setq in
(sslength ss))
(setq pt (cdr
(assoc 10 (entget (ssname ss (setq in (1- in)))))))
(setq txt
(strcat " " (strcase sta) (rtos nma 2 0)))
(metxt pt 7
txth 0 txt)
(setq result
(append
result
(list
(list
txt ;;
text
(car
pt) ;; x value of point
(cadr
pt) ;; y value of point
(caddr
pt) ;; z value of point
)
)
)
)
(setq nma (1+
nma))
(setq ctr (1+
ctr))
)
(setq lst1 result)
)
)
)
)
;;-----------------------------
(if
(= opt "3")
(progn
(initget "1 2")
(setq opt1 (getkword "\nSelect
Options : \n [ 1 Point / 2 Circle ] <1> "))
(if (= opt1 "")(setq opt1
"1"))
(if (= opt1 "1")
(setq points (ssget "_X"
'((0 . "POINT"))))
(setq points (ssget "_X"
'((0 . "CIRCLE"))))
)
(setq texts (ssget "_X" (list (cons 0
"MTEXT,TEXT"))))
(setq i 0)
(setq result (list))
(repeat (sslength points)
(setq j 0)
(setq dst nil) ;; this will hold the closest distance. If a new closer distance is found we replace
dst by that new value
(setq ind nil)
(repeat (sslength texts)
(setq d (distance
(setq
pt (cdr (assoc 10 (entget (ssname points i)))))
;; insert point of the point
(cdr
(assoc 10 (entget (ssname texts j)))) ;; insert point of the text
)
)
(if (or (= dst nil) (< d
dst))
(progn
(setq dst d)
(setq ind j)
)
)
(setq j (+ j 1))
)
(setq result
(append result
(list
(list
(cdr
(assoc 1 (entget (ssname texts ind))))
;; text
(nth 0
pt) ;;
x value of point
(nth 1
pt) ;;
y value of point
(nth 2
pt)
;; z value of point
)
)
)
)
(ssdel (ssname texts ind) texts) ;; to exclude TEXT that is already paired on
the next loop
(setq i (+ i 1))
)
(setq lst1 (reverse result))
)
)
(print_table lst1)
(setvar
"cmdecho" old_cmdecho)
(princ)
);;end
(prompt
"\nEnter CC2TZ to start Circle Closest to text.")
;;------------------------------------------------------
(defun
metxt (pt pos txth ang txt);;Mtext Maker
(entmake
(list
(cons 0
"MTEXT")
(cons 100
"AcDbEntity")
(cons 100
"AcDbMText")
(cons 7
"txtS");;fontstyle
(cons 8
"CC2T_NEZ");;Layer nmae
(cons 71 pos) ; 1=Top
Left /2=Top Center /3= Top Right
; 4=Middle Left/5=Middle Center/6=Middle
Right
; 7=Bottom Left/8=Bottom Center/9=Bottom
Right
(cons 72 5)
(cons 73 1)
(cons 10 pt);;Text
point
(cons 11 (list 1.0
0.0 0.0))
(cons 50 ang);;Angle
Radial only
;(cons 41 19.35)
(cons 40 TXTH);;Text
Height
(cons 44 1.0)
(cons 1 TXT);;Text
String
);list
);entmake
)
;;------------------------------------------------------
(defun
print_table (lst / )
(setq
old_osnap (getvar "osmode")) ;
osnap
(setq
old_layer (getvar "clayer")) ;
layer
(setvar
"osmode" 0)
(setq pt0 (getpoint "\nPick a table
point :")
txth (getvar "TEXTSIZE")
dec 3
num 0
nump (length lst)
)
(setq pt1
(list (+(car pt0)(* txth 10))(cadr pt0))
ptx1 (list (+(car pt0)(* txth 5)) (-(cadr pt0)(* txth 1.0)))
pt2 (list (+(car pt1)(* txth
10))(cadr pt1))
ptx2 (list (+(car pt1)(* txth 5)) (-(cadr pt1)(* txth 1.0)))
pt3 (list (+(car pt2)(* txth
10))(cadr pt2))
ptx3 (list (+(car pt2)(* txth 5)) (-(cadr pt2)(* txth 1.0)))
pt4 (list (+(car pt3)(* txth
10))(cadr pt3))
ptx4 (list (+(car pt3)(* txth 5)) (-(cadr pt3)(* txth 1.0)))
)
(setvar "clayer"
"CC2T_NEZ")
(command "_line" pt0 pt4
"")
(metxt ptx1 5 txth 0 "SYMBOL")
(metxt ptx2 5 txth 0 "NORTH")
(metxt ptx3 5 txth 0 "EAST")
(metxt ptx4 5 txth 0 "ELEVATIONS")
(setq pt0b (list (car pt0)(-(cadr pt0)(* txth 2.0)))
pt1b (list (car pt1)(-(cadr
pt1)(* txth 2.0)))
pt2b (list (car pt2)(-(cadr
pt2)(* txth 2.0)))
pt3b (list (car pt3)(-(cadr
pt3)(* txth 2.0)))
pt4b (list (car pt4)(-(cadr
pt4)(* txth 2.0)))
)
(command "_line" pt0b pt4b
"")
(repeat nump
(setq ptx1 (list (car ptx1)
(-(cadr ptx1)(* txth 2.0)))
ptx2 (list (car ptx2) (-(cadr ptx2)(* txth
2.0)))
ptx3 (list (car ptx3) (-(cadr ptx3)(* txth
2.0)))
ptx4 (list (car ptx4) (-(cadr ptx4)(* txth
2.0)))
)
(metxt ptx1 5 txth 0 (nth 0 (nth
num lst)))
(metxt ptx2 5 txth 0 (rtos (nth 2
(nth num lst))2 dec))
(metxt ptx3 5 txth 0 (rtos (nth 1
(nth num lst))2 dec))
(metxt ptx4 5 txth 0 (rtos (nth 3
(nth num lst))2 dec))
(setq pt0b (list (car pt0b)(-(cadr pt0b)(* txth 2.0)))
pt1b
(list (car pt1b)(-(cadr pt1b)(* txth 2.0)))
pt2b
(list (car pt2b)(-(cadr pt2b)(* txth 2.0)))
pt3b
(list (car pt3b)(-(cadr pt3b)(* txth 2.0)))
pt4b
(list (car pt4b)(-(cadr pt4b)(* txth 2.0)))
)
(command "_line" pt0b
pt4b "")
(setq num (1+ num))
);repeat
(command "_line" pt0 pt0b
"")
(command "_line" pt1 pt1b
"")
(command "_line" pt2 pt2b
"")
(command "_line" pt3 pt3b
"")
(command "_line" pt4 pt4b
"")
(princ)
(setvar
"osmode" old_osnap) ; old_osnap
(setvar
"clayer" old_layer) ; old_layer
(princ)
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น