社区 › Auto Lisp › lisp用于多重修剪和扩展

trunglupin 发表于 2022-7-5 22:33:22

lisp用于多重修剪和扩展

我有关于pic的多条线或多段线“在
我想在所有交点处进行修剪或延伸，使其变成这样：
 
可能应该使用多条边进行修剪和延伸，并使用以下条件对对象进行多次修剪或延伸：+将修剪到边内的所有线段
+到交点的长度小于A的所有线段将被修剪
+所有不是另一条线而是终点到另一条线的距离小于A的线将被延长。
 
这个结果有Lisp程序的地方吗？
 
谢谢你的关注

marko_ribar 发表于 2022-7-5 22:46:11

我能想到的唯一一件事可能会对你们有所帮助，若有什么需要的话，我建议你们试试这些步骤。。。
 
分解所有线性实体-你应该只有直线。。。
2.使用PEDIT->多选项并选择所有行。。。
3.使用此处张贴的plintav new。lsp并选择所有已转换的LW多段线。。。
4.分解所有LW多段线。。。
5.使用区域命令并选择所有线。。。
6.使用QSELECT命令-保留应用于整个图形的选项，在对象类型选择区域中，在下面的过滤器中使用选项选择全部，最后在按钮中选择排除选项…=>将选择除区域之外的所有实体=>点击删除。钥匙
7.保留区域后，按您的意愿操作-删除足够的区域，使用并集、减法、相交等。。。
8.最后将它们分解回直线（我怀疑起始实体属于直线，如果不是只分解你想要的区域…）
9.使用trim（带有内置选项，如“FENCE”表示ex.）、extrim、wptrim（搜索www.获取此代码-我记得在www.augi.com上发布过一个代码），或exb2c（两条曲线之间的extrim-在我最近的帖子中发布），或mextrim（也发布在www.cadtutor.net上）
10、修剪后，寻找需要延伸的线条（EXTEND命令）。。。
 
这是我的新plintav。lsp（新功能是因为它现在可以添加顶点和相交多段线的起点/终点-检查两条多段线是否共线并相互重叠）。。。
 
(defun c:plintav-new ( / intersobj1obj2 LM:Unique AT:GetVertices add_vtx clean_poly
                        ss sslpl sshpl i ent n ent1 ss-ent1 k ent2 intpts intptsall pl plpts par )

(vl-load-com)

(defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
   (if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
   (if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
   (setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendNone))))))
   (if (vl-catch-all-error-p coords)
   (setq ptlst nil)
   (repeat (/ (length coords) 3)
       (setq pt (list (car coords) (cadr coords) (caddr coords)))
       (setq ptlst (cons pt ptlst))
       (setq coords (cdddr coords))
   )
   )
   ptlst
)

(defun LM:Unique ( lst )
   (if lst (cons (car lst) (LM:Unique (vl-remove (car lst) (cdr lst)))))
)

(defun AT:GetVertices ( e / p l )
   (LM:Unique
   (if e
       (if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
         (repeat (setq p (1+ (fix p)))
         (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
         )
         (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
       )
   )
   )
)

(defun add_vtx ( obj add_pt ent_name / bulg sw ew )
   (vla-GetWidth obj (fix add_pt) 'sw 'ew)
   (vla-addVertex
         obj
         (1+ (fix add_pt))
         (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray vlax-vbdouble (cons 0 1))
                     (list
                         (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
                         (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
                     )
             )
         )
   )
   (setq bulg (vla-GetBulge obj (fix add_pt)))
   (vla-SetBulge obj
         (fix add_pt)
         (/
             (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
             (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
         )
   )
   (vla-SetBulge obj
         (1+ (fix add_pt))
         (/
             (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
             (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
         )
   )
   (vla-SetWidth obj (fix add_pt) sw (+ sw (* (- ew sw) (- add_pt (fix add_pt)))))
   (vla-SetWidth obj (1+ (fix add_pt)) (+ sw (* (- ew sw) (- add_pt (fix add_pt)))) ew)
   (vla-update obj)
)

(defun clean_poly ( ent / trunc e_lst p_lst )

   (defun trunc ( expr lst )
   (if (and lst (not (equal (car lst) expr)))
       (cons (car lst) (trunc expr (cdr lst)))
   )
   )

   (setq e_lst (entget ent))
   (if (= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
   (progn
       (setq p_lst
                   (vl-remove-if-not
                  '(lambda (x)
                     (or (= (car x) 10)
                           (= (car x) 40)
                           (= (car x) 41)
                           (= (car x) 42)
                     )
                     )
                     e_lst
                   )
             e_lst
                   (vl-remove-if
                  '(lambda (x)
                     (member x p_lst)
                     )
                     e_lst
                   )
       )
       (if (= 1 (logand (cdr (assoc 70 e_lst)) 1))
         (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
         (setq p_lst (reverse (cdr (member (assoc 10 (reverse p_lst)) (reverse p_lst)))))
         )
       )
       (while p_lst
         (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
               p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
         )
       )
       (entmod e_lst)
   )
   )
   (princ)
)

(setq ss (ssget "_:L" (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 128) '(70 . 129) '(-4 . "or>") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
(setq sslpl (ssadd) sshpl (ssadd))
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
   (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   (progn
       (entupd ent)
       (vla-update (vlax-ename->vla-object ent))
       (ssadd ent sslpl)
   )
   )
   (if (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
   (ssadd ent sshpl)
   )
)
(setq i -1)
(while (setq ent (ssname sshpl (setq i (1+ i))))
   (command "_.convertpoly" "l" ent "")
   (entupd ent)
   (vla-update (vlax-ename->vla-object ent))
   (ssadd ent sslpl)
)
(repeat (setq n (sslength ss))
   (setq ent1 (ssname ss (setq n (1- n))))
   (setq ss-ent1 (ssdel ent1 ss))
   (repeat (setq k (sslength ss-ent1))
   (setq ent2 (ssname ss-ent1 (setq k (1- k))))
   (setq intpts (intersobj1obj2 ent1 ent2))
   (setq intptsall (append intpts intptsall))
   )
)
(setq i -1)
(while (setq pl (ssname sslpl (setq i (1+ i))))
   (setq plpts (AT:GetVertices pl))
   (setq intptsall (append plpts intptsall))
)
(setq i -1)
(while (setq pl (ssname sslpl (setq i (1+ i))))
   (foreach pt intptsall
   (if (setq par (vlax-curve-getparamatpoint pl pt))
       (add_vtx (vlax-ename->vla-object pl) par pl)
   )
   )
)
(repeat (setq n (sslength sslpl))
   (clean_poly (ssname sslpl (setq n (1- n))))
)
(setq i -1)
(while (setq ent (ssname sshpl (setq i (1+ i))))
   (command "_.convertpoly" "h" ent "")
)
(princ)
)
HTH，M.R。

trunglupin 发表于 2022-7-5 22:49:38

谢谢你的回复。
 
但当我使用plintav new时。lsp返回如下错误：
“命令：plintav new
选择对象：指定对角点：183找到
选择对象：
; 错误：错误的参数类型：2D/3D点：nil“
你知道什么问题吗？这个Lisp程序的目的是什么？
 
我还想澄清一下PEDIT命令。它有助于将所有直线转换为多段线，rite？那么在PEDIT和全选之后，接下来要做什么（打开/关闭//拟合？
你想让所有的四边形（从4条线的交点创建）成为易于删除的区域吗？
 
请告诉我你的想法？谢谢你的帮助。
Rgs公司

marko_ribar 发表于 2022-7-5 22:53:40

您需要应用plintav new的实体。lsp是多段线。。。所以你只需用PEDIT命令创建它们，选择“M”-多行并选择所有行，然后只需点击ENTER两次。。。所有直线都将转换为LW多段线，之后可以应用plintav new。lsp。。。
 
M、 R。
 
编辑：plintav new的目的。lsp是在选定的lwpolyline的所有交点上添加顶点，新的是因为它适用于共线lwpolyline-添加顶点，其中是另一条干涉的lwpolyline的开始/结束顶点的位置，即共线。。。看看普林塔夫是什么。lsp（不是“新”）有，看看Youtube上的这个视频。。。
 
http://www.cadtutor.net/forum/showthread.php?67924-绘制-polyline-along-with-2-或更多-相邻-闭合多段线/page3&p=#28

trunglupin 发表于 2022-7-5 23:05:14

谢谢你的回复。我得到了它。在所有4条多段线的情况下，生成4个顶点可能会有很大帮助。但它也会在末端创建短的LW多段线，就在干涉之外。所以问题是如何删除所有的短多段线？
剩下的情况是不干扰其他多段线（应该），需要扩展并且需要很多时间，因为在我的情况下有很多。
2、我仍然无法使用您的plintav new，它总是返回2个错误：
“命令：plintav new
选择对象：指定对角点：4
选择对象：
; 错误：无函数定义：TRUNC“
或“命令：PLINTAV-NEW”
选择对象：指定对角点：137
选择对象：
; 错误：错误的参数类型：2D/3D点：nil“

BIGAL 发表于 2022-7-5 23:07:34

一个更简单的建议是在绘制时打断这些线，不过你需要一个lisp，绘制一条线并偏移和打断，我会看看我能提供什么，我有一个解决方案，但它是复制的。从建筑角度来看，这对于墙交点很常见。

trunglupin 发表于 2022-7-5 23:18:07

@比格尔：谢谢。但我还是没有得到你的建议。我需要在插入的谷歌地图图片的基础上重新绘制路线图系统的布局，如下所示：
 

 
如果您有任何解决方案，请提供帮助。

marko_ribar 发表于 2022-7-5 23:26:00

trunglupin，很抱歉我没有在我的（clean\u poly）子功能中包含（trunc）。。。现已修复，感谢您的检查，您可以尝试plintav new。lsp现在。。。
 
先生，您好。

trunglupin 发表于 2022-7-5 23:29:58

是的。Tks非常喜欢Marko ribar，现在plintav new没有问题。lsp。它解决了家乐福十字路口的问题。使用plintav new后，我可以使用快速选择来选择由新顶点组成的所有非常短的线。
但对于T形交叉点，您只需要删除T形交叉点内的3条线（这与家乐福交叉点不同：删除4条线），并且您仍然需要删除2条多段线的2个端点段。
你对此有什么建议吗？

BIGAL 发表于 2022-7-5 23:34:25

我的建议是基于你画的线，你并没有说你是从其他来源，如谷歌地图。
 
重新缩短行可以检查行的长度，如果小于某个值，则删除，但可以删除一些需要的行。

查看完整版本: lisp用于多重修剪和扩展