设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 继续多线段，看似简单，但很有用
123下一页
返回列表 发新帖
查看: 7653|回复: 25

[资源] 继续多线段，看似简单，但很有用

[复制链接]
wzg356
发表于 2014-9-13 01:17:16 | 显示全部楼层 |阅读模式
本帖最后由 wzg356 于 2014-9-13 19:25 编辑

这个小工具，很小众，但对我很有用。找了好久，没找到，自己动手写了。
改了好几个版本，这个觉得还可以，分享给需要的盆友

附件更新POLYLINE  无颜色组码62时的出错

解决3楼dbx511提出的 lwPOLYLINE 继续时按c闭合问题，已更新
  2. ;;;wzg写于2014年3月22日，改了几版，完善在9月5日，还有待完善简化
  3. (defun c:pl-jx ( / oce1 oce2 oce3 oce4 oce5 vxs ss en ent en1 lst pt lw)
  4.   ;;;系统变量
  5.   (command "undo" "be");;命令编组开始
  6.   (setq  oce1 (getvar "cmdecho");;;保存命令响应原变量值
  7.         oce2 (getvar "PLINEWID");;全局线宽
  8.       oce3 (getvar "OSMODE");;;捕捉变量
  9.       oce4 (getvar "CECOLOR");;绘图颜色
  10.       oce5 (getvar "LWDEFAULT");;线宽
  11.   )
  12.   (setvar "cmdecho" 0);;;关闭命令响应
  13.   (setvar "OSMODE" 39);;;改变捕捉模式
  14.   (setvar "PLINETYPE" 2);;;高质量对线段
  15.   
  16. ;;;子函数
  17.   (defun vxs (e / i v lst);;示例(vxs (car (entsel))),返回三维点坐标
  18.     (setq i -1)
  19.     (while
  20.       (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
  21.       (setq lst (cons v lst))
  22.     )
  23.     (reverse lst)
  24.   )  
  25.   
  26. ;;;主程序
  27.   (setq SS (entsel "\n请点取要继续的多线线:"))  
  28.   (setq en (car SS))
  29.   (setq ent (entget en))  
  30.   (if  (or (= (cdr (assoc 0 ent)) "POLYLINE") (= (cdr (assoc 0 ent)) "LWPOLYLINE"))
  31.       (progn
  32.         (setq lst (vxs en))
  33.         (if (= (cdr (assoc 0 ent)) "POLYLINE")
  34.           (progn;继续POLYLINE
  35.             (if(/= (assoc 62 ent)nil)
  36.               (setvar "CECOLOR" (rtos(cdr (assoc 62 ent)) 2 0))
  37.               (setvar "CECOLOR" "BYLAYER")
  38.           )
  39.             (if(/= (assoc 370 ent)nil)(setvar "LWDEFAULT" (cdr (assoc 370 ent))))            
  40.             (command "3dpoly" );注意以下三句的写法
  41.             (foreach pt lst (command pt))
  42.             (while(/=(getvar"cmdactive")0)(command pause))
  43.             (setq en1 (entlast))            
  44.                 (command "_matchprop"  en en1 "")
  45.                 (command "_erase"  en"")
  46.           )
  47.           (progn;继续LWPOLYLINE
  48.             (setq lw (cdr (assoc 43 ent)));实体全局线宽
  49.             (if (= lw nil) (setq lw (cdr (assoc 40 ent))));如果无实体全局线宽  则取起始线宽
  50.             (setq pt (last lst));获取末端点坐标
  51.             ;注意以下2句的写法
  52.             (command "pline"  pt "w" lw lw)
  53.             (while(/=(getvar"cmdactive")0)
  54.               (cond
  55.                 ((or(equal (grread t 8) '(2 67))(equal (grread t 8) '(2 99)))(command (car lst) ""));按下c/C键闭合
  56.                 ((= (car (grread t 8)) 11) (command ""));按下鼠标右键结束
  57.                   (t (command pause))
  58.               )
  59.             )
  60.             (setq en1 (entlast))
  61.             (command "_matchprop"  en en1 "")
  62.             (command "_join"  en1 en "")
  63.           )
  64.         )
  65.         )
  66.         (alert "你选择的不是多线段!")
  67.   )
  68.   ;;;还原系统变量值
  69.     (setvar "cmdecho" oce1);;;恢复命令响应
  70.     (setvar "PLINEWID" oce2);;全局线宽
  71.     (setvar "OSMODE" oce3);;;恢复捕捉模式  
  72.     (setvar "CECOLOR" oce4)
  73.     (setvar "LWDEFAULT" oce5)
  74.     (command "undo" "e")   
  75.     (princ)
  76. )

复制代码

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
"觉得好，就打赏"
打赏
共1人打赏
回复

使用道具 举报

weijiewen
发表于 2023-4-19 15:48:27 | 显示全部楼层
liuhaixin88 发表于 2014-9-16 17:42

这个继续多段线应该最完善了，可选择起端末端，闭合也正确~
回复 支持 反对

使用道具 举报

寒潮大冬瓜
发表于 2024-8-21 17:46:28 | 显示全部楼层
很好→很棒！很好~很棒！！很好……很棒！！！
回复 支持 反对

使用道具 举报

firstinti
发表于 2014-9-13 01:52:08 | 显示全部楼层
不错，很实用，不过有弧度的该如何处理

点评

wzg356
带弧度的LWPOLYLINE也可以继续的  发表于 2014-9-13 10:42
回复 支持 反对

使用道具 举报

wzg356
 楼主| 发表于 2014-9-13 10:18:19 | 显示全部楼层
自己坐板凳

点评

kwok
非常好，不过有个问题， 不能输入c，不然成2条线了接不了  发表于 2014-9-13 14:48
回复 支持 反对

使用道具 举报

dbx511
发表于 2014-9-13 15:59:31 | 显示全部楼层
本帖最后由 dbx511 于 2014-9-13 16:01 编辑

这个很不错阿。非常不错！另外有点小小的建议，如果把之前画的多义线break,或者trim最后画的那一段后，（就是去掉了原来多义线的最后一个端点或几个端点含最后一个端点）用这个命令继续画的画，继续画的多义线的圆弧就没法和之前原多义线修剪修改后的最后一个点或最后几个点的剩下部分的多义线圆滑连接。估计是修改原多义线后最后一个点的连续的方位角改变了。希望能考虑这种情况，增加判断继续画的之前那个多义线如果有修改，（最后一个点或几个点被修改掉后），能重新判断之前那个修改后的多义线的最后一个点的相关参数，使继续画的部分能和其圆滑连接。谢谢！

点评

wzg356
我还很菜，还不会这些  发表于 2014-9-13 16:22
回复 支持 反对

使用道具 举报

wzg356
 楼主| 发表于 2014-9-13 16:27:50 | 显示全部楼层
本帖最后由 wzg356 于 2014-9-13 19:26 编辑
wzg356 发表于 2014-9-13 10:18
自己坐板凳

继续POLYLINE 可以输入c闭合.
LWPOLYLINE 输入c闭合 已解决，代码已更新
回复 支持 反对

使用道具 举报

aihuyujian
发表于 2014-9-13 18:28:24 | 显示全部楼层
直接comand pl 然后再 coammand FILLET 应该也能达到效果 就是平行的时候可能不行
回复 支持 反对

使用道具 举报

lucas_3333
发表于 2014-9-13 20:32:40 | 显示全部楼层
我也来凑个热闹，对楼主的分享精神要表扬！
对多段线接着画，应该可以选择是从起始端开始画，还是终点开始画。
这个问题之前有讨论过，E大之前给过源码，希望给楼主一个参考。
  1. ;;http://bbs.mjtd.com/thread-107695-2-1.html
  2. ;;by edata
  3. (defun c:tt (/ ss obj end_pt pt c_flag n ch_start ch_close ch_open)
  4.   (vl-load-com)
  5.   (if (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE"))))
  6.     (progn
  7.       (sssetfirst nil ss)
  8.       (setq obj (vlax-ename->vla-object (ssname ss 0))
  9.             ch_close nil
  10.             ch_start nil
  11. ;;;            ch_open nil
  12.             )
  13.       (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
  14.       (while (and (not ch_close)
  15.                   (car (list t (initget "S E C O _start end close open" )))
  16.                   (setq pt (getpoint end_pt "\n指定下一点[S从起点开始/E从终点开始/C闭合/O打开]:"))
  17.              ) ;_ end of and
  18.         (cond
  19.           ((= (type pt) 'list)
  20.      (setq pt(trans pt 1 0))
  21.            (if (vlax-curve-isClosed obj)
  22.              (setq n          (fix (1- (vlax-curve-getendParam obj)))
  23.                    c_flag t
  24.              ) ;_ end of setq
  25.              (setq n          (fix (vlax-curve-getendParam obj))
  26.                    c_flag nil
  27.              ) ;_ end of setq
  28.            ) ;_ end of if
  29.            (if (or ch_start c_flag )
  30.              (progn
  31.                (vla-addvertex
  32.                  obj
  33.                  0
  34.                  (vlax-safearray-fill
  35.                    (vlax-make-safearray vlax-vbDouble '(0 . 1))
  36.                    (list (car pt) (cadr pt))
  37.                  ) ;_ end of vlax-safearray-fill
  38.                ) ;_ end of vla-addvertex
  39.                (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
  40.              ) ;_ end of progn
  41.              (progn
  42.                (vla-addvertex
  43.                  obj
  44.                  (1+ n)
  45.                  (vlax-safearray-fill
  46.                    (vlax-make-safearray vlax-vbDouble '(0 . 1))
  47.                    (list (car pt) (cadr pt))
  48.                  ) ;_ end of vlax-safearray-fill
  49.                ) ;_ end of vla-addvertex
  50.                (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
  51.              ) ;_ end of progn
  52.            ) ;_ end of if
  53.           )
  54.           ((and (= (type pt) 'str)(= pt "start"))
  55.            (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
  56.            (setq ch_start t)
  57.            )
  58.           ((and (= (type pt) 'str)(= pt "end"))
  59.            (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
  60.            (setq ch_start nil)           
  61.            )
  62.           ((and (= (type pt) 'str)(= pt "close"))
  63.            (if (not(vlax-curve-isClosed obj))
  64.              (vla-put-closed obj 1))
  65.            (setq ch_close t)           
  66.            )
  67.           ((and (= (type pt) 'str)(= pt "open"))
  68.            (if (vlax-curve-isClosed obj)
  69.              (vla-put-closed obj 0))
  70. ;;;           (setq ch_open t)           
  71.            )
  72.         ) ;_ end of cond
  73.       ) ;_ end of while
  74.     ) ;_ end of progn
  75.   ) ;_ end of if
  76.   (sssetfirst nil)
  77.   (princ)
  78. ) ;_ end of defun

点评

wzg356
感谢，明经让我开阔了眼界  发表于 2014-9-13 21:27
回复 支持 反对

使用道具 举报

dbx511
发表于 2014-9-13 21:26:46 | 显示全部楼层
lucas_3333 的源码，好象多义线只能画直线段，不能画弧线段。谢谢wzg356 的修改，不过好象比如在原多义线画完后，用了别的命令画了其他的线或者圆弧后，在用继续画的那个程序，画出来的线的弧段和原来的多义线不能圆滑链接。

点评

wzg356
原来的保持原样，继续的只能如pl或3dpoly画折线.作为程序，选择太多，反而失去高效的目的  发表于 2014-9-13 21:45
lucas_3333
不是我的源码，这上E大的，我只是贴上供楼主参考  发表于 2014-9-13 21:40
回复 支持 反对

使用道具 举报

USER2128
发表于 2014-9-14 09:04:20 | 显示全部楼层
程序很实用，感谢楼主！
回复 支持 反对

使用道具 举报

杜阳
发表于 2014-9-14 11:09:22 | 显示全部楼层
程序很实用  但是里面存着一个问题就是，能不能换方向啊，假设一条直线  利用程序继续画线的那个端点不是我想继续画的  线的另一头是我想画的  能不能加一个可以换方向的自定义函数  就更完美了  期待高作
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-25 09:32 , Processed in 0.172317 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表