[编程交流] 在li的中点插入块

(defun c:VHlines ( / _Ang *error* kw e i sn ss )
 ;;; Tharwat 13. Dec. 2012  ;;;
 ;;; modified by miller87 27/04/2015 
 (defun _Ang (e) (angle (cddr (assoc 10 e)) (cddr (assoc 11 e))))
 (defun *error* (msg) (princ "\n Error...*Cancelled*"))
 (if (and (progn 
                 (setq kw "Vertical"
                 )
          )
          (setq s  (ssadd)
                ss (ssget "_x" (list '(0 . "LINE") (cons 410 (getvar 'ctab))))
          )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i)))
             e  (entget sn)
       )
       (cond ((eq kw "Vertical")
              (if (or (equal (_Ang e) (* pi 0.5)) (equal (_Ang e) (* pi 1.5)))
                (ssadd sn s)
              )
             )
             ((eq kw "Horizontal")
              (if (or (equal (_Ang e) pi) (equal (_Ang e) 0.))
                (ssadd sn s)
              )
             )
             (t
              (if (or (equal (_Ang e) (* pi 0.5)) (equal (_Ang e) (* pi 1.5)) (equal (_Ang e) pi) (equal (_Ang e) 0.))
                (ssadd sn s)
              )
             )
       )
     )
     (sssetfirst nil s)
   )
 )
 (princ)
)

[b][color=BLACK]([/color][/b]defun c:mvert [b][color=FUCHSIA]([/color][/b]/ ss i en ed p1 p2 z1 z2 ll ip bn[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]setq i 0[b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss i[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                  p1 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                  p2 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 11 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]and [b][color=GREEN]([/color][/b]equal [b][color=BLUE]([/color][/b]car  p1[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]car  p2[b][color=BLUE])[/color][/b] 1e-8[b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]equal [b][color=BLUE]([/color][/b]cadr p1[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]cadr p2[b][color=BLUE])[/color][/b] 1e-8[b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]setq z1 [b][color=BLUE]([/color][/b]caddr p1[b][color=BLUE])[/color][/b]
                       z2 [b][color=BLUE]([/color][/b]caddr p2[b][color=BLUE])[/color][/b]
                       ll [b][color=BLUE]([/color][/b]abs [b][color=RED]([/color][/b]- z1 z2[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                       ip [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]car p1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cadr p2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]+ [b][color=PURPLE]([/color][/b]min z1 z2[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]* ll 0.5[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                       bn [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"M"[/color] [b][color=RED]([/color][/b]rtos ll 2 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]tblsearch [color=#2f4f4f]"BLOCK"[/color] bn[b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]entmake [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=RED])[/color][/b][b][color=RED]([/color][/b]cons 2 bn[b][color=RED])[/color][/b][b][color=RED]([/color][/b]cons 10 ip[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq i [b][color=GREEN]([/color][/b]1+ i[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun c:mvert (/ )
(and (setq ss (ssget "X" '((0 . "LINE"))))
     (setq i 0)
     (while (setq en (ssname ss i))
            (setq ed (entget en)
                  p1 (cdr (assoc 10 ed))
                  p2 (cdr (assoc 11 ed)))
            (and (equal (car  p1) (car  p2) 1e-
                 (equal (cadr p1) (cadr p2) 1e-
                 (setq z1 (caddr p1)
                       z2 (caddr p2)
                       ll (/ (abs (- z1 z2)) 10.0)
                lll (* ll 10.0)
                       ip (list (car p1) (cadr p2) (+ (min z1 z2) (* lll 0.5)))
                       bn (strcat  (rtos ll 2 0) "M"))
                 (tblsearch "BLOCK" bn)
                 (entmake (list (cons 0 "INSERT")(cons 2 bn)(cons 10 ip))))
            (setq i (1+ i))))
 (prin1)
 )