在边缘上打开多段线

Lee Mac · 发表于 2022-7-6 12:48:16

最后，这应处理不同的多段线宽度：


[i][color=#990099];; Open Polylines at Selected Edge[/color][/i]
[i][color=#990099];; Copyright © 2009 Lee McDonnell ~ 20.08.2009[/color][/i]
[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:PlOpen [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] doc ent Obj pPar pCrds lst Blg i Wid st en[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect LWPolyline: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"AcDbPolyline"[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ObjectName[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [color=Blue][b]:vlax-true[/b][/color] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Closed[/color][/b] Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b]           
     [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] doc[b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pPar
         [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]fix[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getParamatPoint[/color][/b] Obj
               [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getClosestPointto[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pCrds
         [b][color=RED]([/color][/b]vlax-list->2D-point
           [b][color=RED]([/color][/b][b][color=BLUE]vlax-safearray->list[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-variant-value[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Coordinates[/color][/b] Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             lst [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]fix[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getStartParam[/color][/b] Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] i [b][color=#009900]-1[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]repeat[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]1-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]length[/color][/b] pCrds[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Blg
         [b][color=RED]([/color][/b]remake-list
           [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]vla-getBulge[/color][/b] Obj x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]reverse[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           pPar[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] x [b][color=RED]([/color][/b][b][color=BLUE]reverse[/color][/b] lst[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-getWidth[/color][/b] Obj x [b][color=DARKRED]'[/color][/b]st [b][color=DARKRED]'[/color][/b]en[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Wid [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] st en[b][color=RED])[/color][/b] Wid[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Wid [b][color=RED]([/color][/b]remake-list [b][color=RED]([/color][/b][b][color=BLUE]reverse[/color][/b] Wid[b][color=RED])[/color][/b] pPar[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vla-put-Coordinates[/color][/b] Obj
         [b][color=RED]([/color][/b][b][color=BLUE]vlax-make-variant[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]vlax-safearray-fill[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-make-safearray[/color][/b]
               [color=Blue][b]vlax-vbdouble[/b][/color] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]1-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]*[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]length[/color][/b] pCrds[b][color=RED])[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]apply[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]append[/color][/b] [b][color=RED]([/color][/b]remake-list pCrds pPar[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x y[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vla-setBulge[/color][/b] Obj
               [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b] x[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vla-SetWidth[/color][/b] Obj i [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] y[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] y[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Blg Wid[b][color=RED])[/color][/b]                
       [b][color=RED]([/color][/b][b][color=BLUE]vla-put-closed[/color][/b] Obj [b][color=Blue]:vlax-false[/color][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]      
     [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** LWPolyline not Closed **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n** Object Not an LWPolyline **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] vlax-list->2D-point [b][color=RED]([/color][/b]lst[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] lst
   [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b]vlax-list->2D-point [b][color=RED]([/color][/b][b][color=BLUE]cddr[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] Remake-List [b][color=RED]([/color][/b]lst i [b][color=BLUE]/[/color][/b] j k[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=#009900]-1[/color][/b] k [b][color=#009900]-1[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vl-remove-if[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] j[b][color=RED])[/color][/b][b][color=RED])[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vl-remove-if[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]>=[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] k [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] k[b][color=RED])[/color][/b][b][color=RED])[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

DWG Destroyer · 发表于 2022-7-6 12:53:54

确实如此！非常感谢。

Lee Mac · 发表于 2022-7-6 12:56:05

没问题-我做得很开心

alanjt · 发表于 2022-7-6 12:58:28

我之前没有想过，但是使用这个和只使用trim有什么区别？
拾取柱脚线，拾取柱脚线中的线段。

Lee Mac · 发表于 2022-7-6 13:01:01

不知道你可以用那种方式修剪

我对使用AutoCAD的缺乏经验再次打击了…：眨眼：

alanjt · 发表于 2022-7-6 13:05:14

我不知道为什么我没有早点考虑。我一看到它张贴在theswamp上，就意识到了这一点。因为这是一个请求，我想我应该发布信息。

gile · 发表于 2022-7-6 13:07:31

你好

只是为了好玩。
使用entmod更简洁一些（也适用于打开的多段线）。

copy

(defun c:PlOpen (/ pl pt pa l1 l2 l3 cl)
 (vl-load-com)
 (if (and
       (setq pl (entsel "\nSelect the pline segment: "))
       (setq pt (trans (osnap (cadr pl) "_nea") 1 0))
       (setq pl (car pl))
       (setq el (entget pl))
       (= "LWPOLYLINE" (cdr (assoc 0 el)))
     )
   (progn
     (foreach p el
       (if (member (car p) '(10 40 41 42))
         (setq l2 (cons p l2))
         (setq l1 (cons p l1))
       )
     )
     (setq l2 (reverse l2)
           cl (assoc 70 el)
     )
     (repeat (* 4 (1+ (fix (vlax-curve-getParamAtPoint pl pt))))
       (setq l2 (append (cdr l2) (list (car l2))))
     )
     (entmod (append (subst (cons 70 (Boole 2 (cdr cl) 1)) cl (reverse l1)) l2)
     )
   )
 )
 (princ)
)

Lee Mac · 发表于 2022-7-6 13:11:33

嘿，吉尔！

很高兴在这些地方见到你-欢迎来到CADTutor

我在theSwamp上看到了ElpanoveGeniy的一个类似方法——聪明的东西：眨眼：

RenManZ · 发表于 2022-7-6 13:13:40

如何更改此例程以添加圆弧，而不是使用删除线段
（vla setbulge（vlax ename->vla对象（car（entsel）））0 1）

gile · 发表于 2022-7-6 13:19:27

伦曼茨

copy

(setq pl (entsel)
     pt (trans (osnap (cadr pl) "_nea") 1 0)
     pl (car pl)
     pa (fix (vlax-curve-getParamAtPoint pl pt))
)
(vla-setbulge (vlax-ename->vla-object pl) pa 1.0)

但这里有一个完整的例程，我写了很多次了

copy

;; CRUV (gile) -Gilles Chanteau-
;; Transforms a straight polyline segment into a curve one
(defun c:curv (/ *error* pl pt no scu pa p1 p2 bu mid cor loop gr pm fl
          str ce di)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (defun *error* (msg)
   (or    (= msg "Function cancelled")
   (princ (strcat "Error: " msg))
   )
   (vla-SetBulge pl pa bu)
   (and scu
    (vl-cmdf "_.ucs" "_restore" "scuinit")
    (vl-cmdf "_.ucs" "_delete" "scuinit")
   )
   (grtext)
   (redraw)
   (vla-EndUndoMark *acdoc*)
 )
 (if
   (and
     (setq pl (entsel))
     (setq pt (trans (osnap (cadr pl) "_nea") 1 0))
     (setq no (cdr (assoc 210 (entget (car pl)))))
     (setq pl (vlax-ename->vla-object (car pl)))
     (= (vla-get-ObjectName pl) "AcDbPolyline")
   )
    (progn
      (vla-StartUndoMark *acdoc*)
      (if (not
        (and (equal '(0 0 1)
            (trans '(0 0 1) no 1 T)
            1e-9
         )
         (equal 0.0 (vla-get-elevation pl) 1e-9)
        )
      )
    (and
      (vl-cmdf "_.ucs" "_save" "scuinit")
      (setq scu T)
      (vl-cmdf "_.ucs" "_object" (vlax-vla-object->ename pl))
    )
      )
      (setq pa      (fix (vlax-curve-getParamAtPoint pl pt))
        p1      (trans (vlax-curve-getPointatParam pl pa) 0 no)
        p2      (trans (vlax-curve-getPointatParam pl (1+ pa)) 0 no)
        bu      (vla-GetBulge pl pa)
        mid  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
        cor  (distance mid p1)
        loop T
      )
      (princ "\nSpecify the height (sagitta) or [Center/Direction]: ")
      (while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
    (cond
      ((= (car gr) 5)
       (redraw)
       (setq pm (trans (cadr gr) 1 no)
         fl (distance mid pm)
       )
       (and (< (sin (- (angle p1 p2) (angle p1 pm))) -1e-14)
        (setq fl (- fl))
       )
       (vla-setBulge
         pl
         pa
         ((lambda (a) (/ (sin a) (cos a)))
       (/ (- (angle p2 pm) (angle pm p1)) 2.0)
         )
       )
       (grdraw (trans mid no 1)
           (trans (vlax-curve-getPointAtParam pl (+ pa 0.5)) 0 1)
           -1
           1
       )
       (grtext -1 (strcat "Height = " (rtos fl)))
      )
      ((member (cadr gr) '(13 32))
       (cond
         ((and str (numberp (read str)))
          (vla-setBulge pl pa (/ (read str) cor))
          (setq loop nil)
         )
         ((and str (member (strcase str) '("C" "D")))
          (setq loop nil)
          (cond
        ((= (strcase str) "C")
         (while
           (not (and
              (setq
                ce
                 (trans (getpoint "\nSpecify le center: ")
                    1
                    no
                 )
              )
              (equal (distance ce p1) (distance ce p2) 1e-9)
            )
           )
            (princ
                      "\nThe specified point can't be the arc center"
            )
         )
         (vla-SetBulge
           pl
           pa
           (/ (- (distance ce p1) (distance ce mid))
              (if
            (< (sin (- (angle p1 p2) (angle p1 ce))) -1e-14)
             (distance p1 mid)
             (- (distance p1 mid))
              )
           )
         )
         (initget "Yes No")
         (if
           (=
             "Yes"
             (getkword
           "\nDraw the complementary arc ? [Yes/No] <No>: "
             )
           )
            (vla-SetBulge
              pl
              pa
              (/ (+ (distance ce p1) (distance ce mid))
             (if (< (sin (- (angle p1 p2) (angle p1 ce)))
                -1e-14
                 )
               (- cor)
               cor
             )
              )
            )
         )
        )
        ((= (strcase str) "D")
         (while
           (not (setq di (getpoint (trans p1 no 1)
                       "\nSpecify the direction: "
                 )
            )
           )
         )
         ((lambda (a)
            (vla-SetBulge pl pa (/ (sin a) (cos a)))
          )
           (/ (- (angle p1 p2) (angle p1 (trans di 1 no))) 2.0)
         )
        )
          )
         )
         (T
          (princ
                "\nNeeds a number, a valid option or a cursor input.
                \nSpecify the height (sagitta) or [Center/Direction]: "
          )
          (setq str "")
         )
       )
      )
      (T
       (if    (= (cadr gr) 
         (or
       (and str
            (/= str "")
            (setq str (substr str 1 (1- (strlen str))))
            (princ (chr )
            (princ (chr 32))
       )
       (setq str nil)
         )
         (or
       (and str (setq str (strcat str (chr (cadr gr)))))
       (setq str (chr (cadr gr)))
         )
       )
       (and str (princ (chr (cadr gr))))
      )
    )
      )
      (and scu
       (vl-cmdf "_.ucs" "_restore" "scuinit")
       (vl-cmdf "_.ucs" "_delete" "scuinit")
      )
      (grtext)
      (redraw)
      (vla-EndUndoMark *acdoc*)
    )
 )
 (princ)
)

[编程交流] 在边缘上打开多段线

发表回复

精选推荐