;; Point or Circle Closest To Text
(defun
c:cc2t ( / 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))
;;------------------------------------
)
)
(if
(= opt "1")
(progn
(while(setq pt (getpoint "\nPick
Points :"))
(setq txt (strcat " "
(strcase sta) (rtos nma 2 0)))
(command "_.text"
"_s" txtS "_j" "bl" pt 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)))
(command
"_.text" "_s" txtS "_j" "bl" pt 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 (1+ j))
)
(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
)
)
)
)
(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 CC2T to start Circle Closest to text.")
;;------------------------------------------------------
(defun
print_table (lst / )
(setq
old_osnap (getvar "osmode")) ;
osnap
(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)))
)
(command "_line" pt0 pt3
"")
(command "_text"
"mc" ptx1 txth "0" "SYMBOL")
(command "_text"
"mc" ptx2 txth "0" "NORTH")
(command "_text"
"mc" ptx3 txth "0" "EAST")
(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)))
)
(command "_line" pt0b pt3b
"")
(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)))
)
(command "_text"
"mc" ptx1 txth "0" (car (nth num lst)))
(command "_text"
"mc" ptx2 txth "0" (rtos(caddr (nth num lst))2 dec))
(command "_text"
"mc" ptx3 txth "0" (rtos(cadr (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)))
)
(command "_line" pt0b
pt3b "")
(setq num (1+ num))
);repeat
(command "_line" pt0 pt0b
"")
(command "_line" pt1 pt1b
"")
(command "_line" pt2 pt2b
"")
(command "_line" pt3 pt3b
"")
(princ)
(setvar
"osmode" old_osnap) ; old_osnap
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น