วันพฤหัสบดีที่ 11 มีนาคม พ.ศ. 2564

Point or Circle Closest To Text (CC2TNEZDa)

 

(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)

)


ไม่มีความคิดเห็น:

แสดงความคิดเห็น