社区 › Auto Lisp › 如何在l周围创建间隙

pBe 发表于 2022-7-6 07:14:31

 
好主意GP\U

EBROWN 发表于 2022-7-6 07:20:42

GP。。。。这很有效。还需要什么代码来包括leader或qleader。

GP_ 发表于 2022-7-6 07:25:59

 
完成错误处理。
自然，它与直线引线一起工作。
真正的挑战是将反应堆（用于清除）连接到mleader，但这是大师的工作，而不是我的工作。
 
 
(defun c:demo (/ s s1 ss space pntlst pntlst1 w pntlst zv
                s_name TempL TempL1 TempL2 Lv L1v L2v )
   (vl-load-com)
   (setq space (vlax-get
               (vla-get-ActiveLayout
               (vla-get-activedocument
                   (vlax-get-acad-object)
               )
               )
               'Block
             )
)
(if (and
         (princ "\nSelect Leader or MLeader")
         (setq s (ssget "_+.:S:L" '((0 . "*LEADER"))))
         (setq s (vlax-ename->vla-object (setq s1 (ssname s 0))))
         (setq s_name (vlax-get s 'ObjectName))
         (setq width (cond
((getdist (strcat "\nEnter width "
(if width (strcat " <" (rtos width) ">: ") ": ")
             )))(width))
)
          (setq w (* 0.5 width))
   )
   (progn
         (cond
             (
               (eq s_name "AcDbMLeader" )
               (setq pntlst (vlax-invoke
                               s 'GetLeaderLineVertices0
                               )
                  ;zv   (nth 2 pntlst)
               )
               (setq pntlst1 nil)
               (repeat (/ (length pntlst) 3)
                   (setq pntlst1 (cons (list (car pntlst) (cadr pntlst)) pntlst1))
                   (setq pntlst (cdddr pntlst))
               )
               (setq pntlst pntlst1)
             )
             (
               (eq s_name "AcDbLeader" )            
               (mapcar '(lambda (x)
                           (if (eq (car x) 10)
                               (setq pntlst (cons (list (cadr x) (caddr x)) pntlst))
                           )
                        )
                     (entget s1)
               )
             )
         )
         (setq TempL
                  (vlax-ename->vla-object
                      (entmakex
                        (append
                              (list
                                  (cons 0 "LWPOLYLINE")
                                  (cons 100 "AcDbEntity")
                                  (cons 100 "AcDbPolyline")
                                  (cons 90 (length pntlst))
                              )
                              (mapcar '(lambda (x) (cons 10 x)) pntlst)
                        )
                     )
                  )
         )
         (vlax-invoke TempL 'offset (- (* 0.5 width)))
         (setq TempL1 (entlast))
         (vlax-invoke TempL 'offset (* 0.5 width))
         (setq TempL2 (entlast))
         (setq
             Lv1 (coo TempL1)
             Lv2 (coo TempL2)
             Lv (append Lv1 (reverse Lv2))
          )
         (setq os (getvar 'osmode))
         (setvar 'osmode 0)
         (command "_.wipeout")
         (apply 'command Lv)
         (command "")
         (setvar 'osmode os)
         (command "_.draworder" s1 "" "_F")
         (vla-delete TempL)
         (entdel TempL1)
         (entdel TempL2)
   )
)      
)

(defun Coo ( a / coor)            
   (mapcar '(lambda (x)
                (if (eq (car x) 10)
                  (setq coor (cons (list (cadr x) (caddr x)) coor))
                )
            )
            (entget a)
    )
   coor
)

ggs_1689 发表于 2022-7-6 07:26:18

你好Tharwat，我尝试了你的代码，效果很好。但它只能在线路上工作。你认为它有可能在圆、样条曲线、圆弧等上面工作吗？

查看完整版本: 如何在l周围创建间隙