(defun
print_out (lst / a)
(foreach a lst
(princ "\n")
(princ a)
)
)
;|
25-11-2020
Point or Circle Closest To Text
change text to mtext for 3D coordinate
add table Z ( elevations)
27-11-2020
add table distance a1 to a2 in plan view
10-03-2021
add opt2 => No. E N Z D
|;
(defun
c:cc2tnezda ( / points texts i j pt pb 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")(= opt "3"))
(progn
;;---------------------------
(initget "1 2")
(setq opt2 (getkword "\nSelect
Options : \n [1 Symbol N E Z D / 2 No E N Z D ] <1> "))
(if (= opt2 "")(setq opt2
"1"))
(if (= opt2 "1")
(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
(progn ;;;options 2
;;----------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
);progn
);if
;;------------------------------------
(setq
pb nil)
(if
(= opt "1")
(progn
(while(setq pt (getpoint "\nPick
Points :"))
(if (= pb nil)(setq pb pt))
(if (= opt2 "1")
(setq txt (strcat "
" (strcase sta) (rtos nma 2 0)))
(setq txt (strcat "
" (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
(distance
(list (car pt)(cadr pt)) (list (car pb)(cadr pb)))
)
)
)
)
(setq nma (1+ nma)
pb pt
)
)
(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)))))))
(if (= pb
nil)(setq pb pt))
(if (= opt2
"1")
(setq txt
(strcat " " (strcase sta) (rtos nma 2 0)))
(setq txt
(strcat " " (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
(distance
(list (car pt)(cadr pt)) (list (car pb)(cadr pb)))
)
)
)
)
(setq nma (1+ nma)
pb pt
)
(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 result (list))
(setq pc nil)
(repeat (setq im (sslength points))
(setq ent (ssname points (setq im
(1- im))));;;make reverse points
(setq j 0)
(setq dst nil) ;; this will hold the closest distance.
(setq ind nil)
(repeat (sslength texts)
(setq d (distance
(setq pt
(cdr (assoc 10 (entget ent)))) ;;
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))
)
(if (= pc nil)(setq pc pt))
(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
(distance
(list (car pt)(cadr pt)) (list (car pc)(cadr pc)))
)
)
)
)
(ssdel (ssname texts ind) texts)
(setq pc pt)
)
(setq lst1 result);(reverse result)
)
)
(print_out result)
(print_table lst1)
(setvar
"cmdecho" old_cmdecho)
(princ)
);;end
(prompt
"\nEnter CC2TNEZDa 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)) ;;Z
elevations
ptx4 (list (+(car pt3)(* txth 5)) (-(cadr pt3)(* txth 1.0)))
pt5 (list (+(car pt4)(* txth
10))(cadr pt4)) ;;distance
ptx5 (list (+(car pt4)(* txth 5)) (-(cadr pt4)(* txth 1.0)))
)
(setvar "clayer"
"CC2T_NEZ")
(command "_line" pt0 pt5
"")
(if (= opt2 "1")
(progn
(metxt ptx1 5 txth 0
"SYMBOL")
(metxt ptx2 5 txth 0
"NORTH")
(metxt ptx3 5 txth 0
"EAST")
(metxt ptx4 5 txth 0
"ELEVATIONS")
(metxt ptx5 5 txth 0
"DISTANCE")
)
(progn
(metxt ptx1 5 txth 0
"NO.")
(metxt ptx2 5 txth 0
"EAST")
(metxt ptx3 5 txth 0
"NORTH")
(metxt ptx4 5 txth 0
"ELEVATIONS")
(metxt ptx5 5 txth 0
"DISTANCE")
)
)
(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)));;elevations
pt5b (list (car pt5)(-(cadr
pt5)(* txth 2.0)));;distance
)
(command "_line" pt0b pt5b
"")
(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)))
ptx5 (list (car ptx5) (-(cadr ptx5)(* txth
2.0)))
)
(if (= opt2 "1")
(progn
(metxt ptx1 5 txth 0 (nth 0
(nth num lst)))
(metxt ptx2 5 txth 0 (rtos
(nth 2 (nth num lst))2 dec));N
(metxt ptx3 5 txth 0 (rtos
(nth 1 (nth num lst))2 dec));E
(metxt ptx4 5 txth 0 (rtos
(nth 3 (nth num lst))2 dec));Z
(metxt ptx5 5 txth 0 (rtos
(nth 4 (nth num lst))2 dec));D
)
(progn
(metxt ptx1 5 txth 0 (nth 0
(nth num lst)))
(metxt ptx2 5 txth 0 (rtos
(nth 1 (nth num lst))2 dec));E
(metxt ptx3 5 txth 0 (rtos
(nth 2 (nth num lst))2 dec));N
(metxt ptx4 5 txth 0 (rtos
(nth 3 (nth num lst))2 dec));Z
(metxt ptx5 5 txth 0 (rtos
(nth 4 (nth num lst))2 dec));D
)
)
(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)))
pt5b
(list (car pt5b)(-(cadr pt5b)(* txth 2.0)))
)
(command "_line" pt0b pt5b
"")
(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
"")
(command "_line" pt5 pt5b
"")
(princ)
(setvar
"osmode" old_osnap) ; old_osnap
(setvar
"clayer" old_layer) ; old_layer
(princ)
)
