;|
25-11-2020
Point or Circle Closest To Text CC2TZD
change text to mtext for 3D
coordinate
add table Z ( elevations)
27-11-2020
add table distance a1
to a2 in plan view
|;
(defun c:cc2tzd ( / 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"))
(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
;;------------------------------------
(setq pb nil)
(if (= opt "1")
(progn
(while(setq pt (getpoint "\nPick
Points :"))
(if (= pb nil)(setq pb pt))
(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
(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))
(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
(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_table lst1)
(setvar
"cmdecho" old_cmdecho)
(princ)
);;end
(prompt
"\nEnter CC2TZD 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 "")
(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")
(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)))
)
(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))
(metxt ptx5 5
txth 0 (rtos (nth 4 (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)))
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)
)
