[编程交流] 寻找标签线

(defun c:td (/ dt layerset hr raf1 raf2 ss en ed p10 p11 mpt d2d d1d d3d d4d lan tan fg hg)
 (vl-load-com)
 (defun errorhandler (s)
   (if    (/= s "Function cancelled")
     (princ (strcat "\nError: " s))
     (princ "SW function cancelled!")
   )                    ;end if
   (setvar "clayer" layerset)
   (setvar "orthomode" orthoset)
   (setvar "osmode" osset)
   (setvar "cmddia" cmddiaset)
   (setvar "attdia" attdiaset)
   (setvar "regenmode" 1)
   (setq *error* olderr)
   (princ)
 )                    ;end defun error
              
 (setq dscal (getvar "dimscale"))
 (setq dimconv (/ 96.0 dscal))
 (setq lspace (* 9.0 (/ dscal 96.0)))
 (setq tfc12 (* 12.0 (/ dscal 96.0)))
;;;;----set variables -------------------------------------
 (setq layerset (getvar "clayer"))
 (command "_.layer" "s" "s-Fnd-Tbeam" "")
 (command "_.layer" "off" "*" "n" "")
 (command
   "_.layer"
   "on"
   "s-fnd-stend,s-fnd-btend,s-fnd-hstend,s-fnd-vstend,s-fnd-vbtend,s-fnd-hbtend"
   ""
 )
 (command "textsize" "6" "")
 (command "_.style" "romans" "0" "0.80" "" "" "" "")
;;;;-----Get point for start side-------------------
 (setq dt (getstring "DBL(2) or TRPL(3) Tendons"))
 (setq arr (getpoint "Pick first side you want the Live end"))
 (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
 (setq count 1)
 
   
 (while (setq en (ssname ss 0))
                   ;(setq e (ssname ss (setq i (1+ i))))
   (setq ed (entget en))
   (setq lyr (cdr (assoc 8 ed)))
   (setq p10 (cdr (assoc 10 ed)))
   (setq p11 (cdr (assoc 11 ed)))
   (setq pln (cdr (assoc 90 ed)))
   (setq pp10 p10)            ;first pline corrd for start placement
   (setq pp9 p11)            ;second pline corrd for start rotation
   (setq pp11 p11)            ;last pline corrd for end placement
   (setq pp12 p10)            ;second to last corrd on miltiple plines for end rotation
   (setq leng (vla-get-length (vlax-ename->vla-object en)))
   (setq leng1 (fix (/ leng 12.0)))
   (if    (= (cdr (assoc 0 ed)) "LWPOLYLINE")
     (progn
   (if (setq chk (= pln 2))
     (setq    pp1  (nth 19 ed)
       pp9  (cdr pp1)        ;start rotation
       pp11 (cdr pp1)        ;end location
     )                ;end setq
                   ;(setq distt1 (fix (/ (distance pp10 pp1) 12.0)))
   )                ;end if 2
   (if (setq chk (= pln 3))
     (setq    pp1  (nth 24 ed)
       pp2  (nth 19 ed)
       pp9  (cdr pp2)        ;start rotation
       pp11 (cdr pp1)        ;end location
       pp12 (cdr pp2)        ;end rotation
     )                ;end setq
                   ;(setq distt1 (fix (/ ((distance pp10 pp2)+(distance pp2 pp1)) 12.0)))
   )                ;end if 3         
   (if (setq chk (= pln 4))
     (setq    pp1  (nth 29 ed)
       pp2  (nth 19 ed)
       pp3  (nth 24 ed)
       pp9  (cdr pp2)        ;start rotation
       pp11 (cdr pp1)        ;end location
       pp12 (cdr pp3)        ;end rotation
     )                ;end setq
   )                ;end if 4
   (if (setq chk (= pln 5))
     (setq    pp1  (nth 34 ed)
       pp2  (nth 19 ed)
       pp3  (nth 29 ed)
       pp9  (cdr pp2)        ;start rotation
       pp11 (cdr pp1)        ;end location
       pp12 (cdr pp3)        ;end rotation
     )                ;end setq
   )                ;end if 5
   (if (setq chk (= pln 6))
     (setq    pp1  (nth 39 ed)
       pp2  (nth 19 ed)
       pp3  (nth 34 ed)
       pp9  (cdr pp2)        ;start rotation
       pp11 (cdr pp1)        ;end location
       pp12 (cdr pp3)        ;end rotation
     )                ;end setq
   )                ;end if 6
     )                    ;end progn
   )                    ;end if 0
;;;insert start and end placement
   (if    (< (distance arr pp10) (distance arr pp11))
     (setq p9 pp10)
   )
   (if    (< (distance arr pp11) (distance arr pp10))
     (setq p9 pp11)
   )
   (if    (> (distance arr pp10) (distance arr pp11))
     (setq p12 pp10)
   )
   (if    (> (distance arr pp11) (distance arr pp10))
     (setq p12 pp11)
   )
   (setq cpi arr)
   (setq cpix (car cpi))
   (setq cpiy (cadr cpi))
   (setq cp (list cpix cpiy))
;;;;start
   (setq cdist1 (distance cp pp10))
   (setq cdist2 (distance cp pp9))
   (if    (< cdist1 cdist2)        ; begin iloop 3
     (setq tsp pp10)
     (setq tsp pp9)
   )                    ; end iloop 3
   (if    (< cdist1 cdist2)        ; begin iloop 4
     (setq tep pp9)
     (setq tep pp10)
   )                    ; end iloop 4
;;;;ends
   (setq cdist13 (distance cp pp11))
   (setq cdist23 (distance cp pp12))
   (if    (< cdist13 cdist23)        ; begin iloop 3
     (setq tsp3 pp11)
     (setq tsp3 pp12)
   )                    ; end iloop 3
   (if    (< cdist13 cdist23)        ; begin iloop 4
     (setq tep3 pp12)
     (setq tep3 pp11)
   )                    ; end iloop 4
                   ;-------JUSTIFICATION---------------            -------------------------
   (setq tenang (angle tsp tep))    ;start angle
   (setq tenang2 (angle tsp3 tep3))    ;(angle tsp3 tep3));end angle
   (setq tenangro (- tenang (/ pi 2.0)))
   (setq tenangro2 (- tenang2 (/ pi 2.0)))
   (setq tenangconv (/ (fix (* 10.0 (* 180.0 (/ tenang pi)))) 10.0))
                   ;text info
   (setq tenro (* 180.0 (/ (- tenangro pi) pi)))
   (setq tenro2 (* 180.0 (/ (- tenangro2 pi) pi)))
                   ;----------------------add the prefix to the lengths   --------------------------------------------------------------
   (if    (= lyr "S-FND-HSTEND")
     (setq tentag (strcat "T" (itoa count) " \(" (itoa leng1) "\)"))
   )
   (if    (= lyr "S-FND-VSTEND")
     (setq tentag (strcat "T" (itoa count) " \(" (itoa leng1) "\)"))
   )
   (if    (= lyr "S-FND-STEND")
     (setq tentag (strcat "T" (itoa count) " \(" (itoa leng1) "\)"))
   )
   (if    (= dt "2")
     (progn
   (if (= lyr "S-FND-HBTEND")
     (setq    tentag (strcat "T"
                  (itoa count)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count2)
                  "\("
                  (itoa leng1)
                  "\) "
              )
     )
   )
   (if (= lyr "S-FND-VBTEND")
     (setq    tentag (strcat "T"
                  (itoa count)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count2)
                  "\("
                  (itoa leng1)
                  "\) "
              )
     )
   )
   (if (= lyr "S-FND-BTEND")
     (setq    tentag (strcat "T"
                  (itoa count)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count2)
                  "\("
                  (itoa leng1)
                  "\) "
              )
     )
   )
     )                    ;end progn
     (progn
   (if (= lyr "S-FND-HBTEND")
     (setq    tentag (strcat "T"
                  (itoa count)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count2)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count3)
                  "\("
                  (itoa leng1)
                  "\) "
              )
     )
   )
   (if (= lyr "S-FND-VBTEND")
     (setq    tentag (strcat "T"
                  (itoa count)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count2)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count3)
                  "\("
                  (itoa leng1)
                  "\) "
              )
     )
   )
   (if (= lyr "S-FND-BTEND")
     (setq    tentag (strcat "T"
                  (itoa count)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count2)
                  "\("
                  (itoa leng1)
                  "\) "
                  "T"
                  (itoa count3)
                  "\("
                  (itoa leng1)
                  "\) "
              )
     )
   )
     )                    ;end progn
   )                    ;end if
   (setq count (1+ count))
   (setq count2 (1+ count))
   (setq count3 (1+ count2))
;;;----------------------------text JUSTIFY----------------------------------------------------------
   (if    (= tenangconv 0.0)
     (setq just "mr")
   )
   (if    (and (> tenangconv 0.0) (<= tenangconv 90.0))
     (setq just "mr")
   )
   (if    (and (> tenangconv 90.0) (< tenangconv 180.0))
     (setq just "ml")
   )
   (if    (= tenangconv 180.0)
     (setq just "ml")
   )
   (if    (and (> tenangconv 180.0) (<= tenangconv 270.0))
     (setq just "ml")
   )
   (if    (> tenangconv 270.0)
     (setq just "mr")
   )
;;;text rotation--------------------------------------------------------------------------------
   (if    (= tenangconv 0.0)
     (setq textroi (- tenangro pi))
   )
   (if    (and (> tenangconv 0.0) (<= tenangconv 90.0))
     (setq textroi (- tenangro pi))
   )
   (if    (and (> tenangconv 90.0) (< tenangconv 180.0))
     (setq textroi tenangro)
   )
   (if    (= tenangconv 180.0)
     (setq textroi tenangro)
   )
   (if    (and (> tenangconv 180.0) (<= tenangconv 270.0))
     (setq textroi tenangro)
   )
   (if    (> tenangconv 270.0)
     (setq textroi (- tenangro pi))
   )
   (setq textro (* 180.0 (/ (- textroi (/ pi 2.0)) pi)))
   ;;text location---------------------------------------------------------------------------------
   (if    (= tenangconv 0.0)
     (setq textp4 tfc12)
   )
   (if    (and (> tenangconv 0.0) (<= tenangconv 90.0))
     (setq textp4 tfc12)
   )
   (if    (and (> tenangconv 90.0) (< tenangconv 180.0))
     (setq textp4 (- 0.0 tfc12))
   )
   (if    (= tenangconv 180.0)
     (setq textp4 (- 0.0 tfc12))
   )
   (if    (and (> tenangconv 180.0) (<= tenangconv 270.0))
     (setq textp4 (- 0.0 tfc12))
   )
   (if    (> tenangconv 270.0)
     (setq textp4 tfc12)
   )
   (setq textp2 (polar p9 tenang lspace))
   (setq textp3 (polar textp2 tenangro2 textp4))
                   ;-----------------------INSERT-----------------------------------------
   (if    (= dt "2")
     (setq btnl "btenl"
       btnd "btend"
     )
   )                    ;end if
   (if    (= dt "3")
     (setq btnl "btenl3"
       btnd "btend3"
     )
   )                    ;end if
   (if    (= lyr "S-FND-STEND")
     (setq btnl "btenl-s")
   )                    ;END IF
   (if    (= lyr "S-FND-STEND")
     (setq btnd "btend-s")
   )                    ;END IF
   (if    (= lyr "S-FND-HSTEND")
     (setq btnl "btenl-s")
   )                    ;END IF
   (if    (= lyr "S-FND-HSTEND")
     (setq btnd "btend-s")
   )                    ;END IF
   (if    (= lyr "S-FND-VSTEND")
     (setq btnl "btenl-s")
   )                    ;END IF
   (if    (= lyr "S-FND-VSTEND")
     (setq btnd "btend-s")
   )                    ;END IF
   (command "_.insert" btnl p9 dscal "" tenro) ;arrow
   (command "_.insert" btnd p12 dscal "" tenro2) ;tails
   (command "_.text" "_s" "ROMANS" "_j" just textp3 ;LOCATION
        lspace            ;HEIGHT
        textro            ;ROTATION
        tentag            ;LENGTH
        "")
   (ssdel en ss)
 )                    ;end while
 (command "_.layer" "on" "*" "" "")
 (setvar "clayer" layerset)
 (prin1)
)                    ;end defun

(defun c:foo (/ a hor i p1 p2 s vrt x)
 ;; Sort bottom left corner then head right
 (if (setq s (ssget '((0 . "line"))))
   (progn ;; Compile a list of angle, smallest horizontal X point, largest vertical Y point
   (setq s (mapcar '(lambda (x)
                      (list ;; Divide angle by PI .  always returns 0 ot (/ pi 2) assuming you have horizontal and vertical lines
                            (setq a (rem (angle        (setq p1 (vlax-curve-getstartpoint x))
                                                (setq p2 (vlax-curve-getendpoint x))
                                         )
                                         pi
                                    )
                            )
                            ;; Return smallest horizontal X point, largest vertical Y point
                            (car (vl-sort (list p1 p2)
                                          '(lambda (a b)
                                             (if (= 0 a)
                                               (< (car a) (car b))
                                               (> (cadr a) (cadr b))
                                             )
                                           )
                                 )
                            )
                      )
                    )
                   ;; Convert selset to list
                   (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
           )
   )
   ;; Separate horizontal from vertical lines
   (setq s (mapcar '(lambda (x)
                      (if (= 0 (car x))
                        (setq hor (cons x hor))
                        (setq vrt (cons x vrt))
                      )
                    )
                   s
           )
   )
   ;; Sort horizontal point by smallest Y value
   (setq hor (vl-sort hor '(lambda (a b) (< (cadr (last a)) (cadr (last b))))))
   ;; Sort vertical point by smallest X value
   (setq vrt (vl-sort vrt '(lambda (a b) (< (car (last a)) (car (last b))))))
   ;; Counter
   (setq i 0)
   ;; Show that it works 
   (mapcar '(lambda (x)
              (entmakex        (list '(0 . "TEXT")
                              '(100 . "AcDbEntity")
                              (cons 8 "text")
                              '(100 . "AcDbText")
                              (cons 10 (cadr x))
                              '(40 . 12.0)
                              (cons 1 (itoa (setq i (1+ i))))
                              (cons 50 (car x))
                              '(72 . 1)
                              (cons 11 (cadr x))
                              '(73 . 2)
                        )
              )
            )
           ;; Sort list by angle
           (append hor vrt)
   )
   ;; Here you can use '((<angle> point)....)
   ;; (foreach (append hor vrt) yada yada)
   )
 )
 (princ)
)