地信网论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

免费视频|新人指南|答学员问|投诉删帖

禁止上传涉密资料|赚取铜板|附件下载

查看: 127|回复: 0
收起左侧

[二次开发] 多段线增加顶点lsp

[复制链接]

3

主题

180

铜板

0

好友

技术员

Rank: 3Rank: 3

积分
78
发表于 2018-11-26 17:49 | 显示全部楼层 |阅读模式
“家乡”主题作品征集大赛

马上注册地信网,享受更多功能,学习更多知识,成就人生精彩!

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
  1. ;;;多段线或直线增加顶点,直线转为多线段
  2. ;wzg 修改于20150417
  3. (defun c:pljd ( / en en2 oldce HH:LwAddVertex)
  4. ;;164.34 [功能] 多段线增加顶点 By 自贡黄明儒
  5. ;;示例(HH:LwAddVertex (car(setq en(entsel))) (cadr en))
  6. (defun HH:LwAddVertex (en pt / GR N PP LwAddVertex)
  7.   ;;增加一个顶点
  8.   (defun LwAddVertex (obj index pt bugle sw ew)
  9.     (vlax-invoke obj 'addvertex index pt)
  10.     (vla-setbulge obj index bugle)
  11.     (vla-setwidth obj index sw ew)
  12.   )
  13.   (setq pp (vlax-curve-getClosestPointTo en (trans pt 1 0)))
  14.   (setq n (fix (vlax-curve-getParamAtPoint en pp)))
  15.   (setq obj (vlax-ename->vla-object en))
  16.   (vla-GetWidth obj n 'sw 'ew)
  17.   (setq pp (getpoint "\n 指定新增点 "))
  18.   (setq pp (mapcar '+ '(0 0) pp))
  19.   (vl-catch-all-apply 'LwAddVertex (list obj (1+ n) pp 0 sw sw))
  20. )
  21. ;;---------------------------
  22. (initget "  ")
  23. (setq en (entsel "\n选择直线或多线段要加点的子段..."))
  24. (cond
  25.         ((= en "")nil)
  26.         ((and en
  27.                 (wcmatch(cdr(assoc 0(entget(car en))))"LWPOLYLINE")
  28.                 )
  29.                 (HH:LwAddVertex (car en) (cadr en))
  30.                  (c:pljd)
  31.         )
  32.         ((and en
  33.                 (wcmatch(cdr(assoc 0 (entget (car en))))"LINE")
  34.             )
  35.                 (setq oldce (getvar "PEDITACCEPT"))
  36.                 (setvar "PEDITACCEPT" 1)
  37.                 (command "pedit" en "W" "0" "")
  38.                 (setvar "PEDITACCEPT" oldce)
  39.                 (setvar "cmdecho" 1)
  40.                 (setq en2 (entlast))
  41.                 (HH:LwAddVertex en2 (cadr en))
  42.                 (c:pljd)
  43.         )
  44.         (t (c:pljd))       
  45. )
  46. (princ)
  47. )

复制代码


评分

参与人数 1铜板 +1 收起 理由
XWIFN + 1

查看全部评分

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

土流网招商加盟广告
在线客服

新人指南|地信论坛 ( 湘ICP备14003170号-5 湖南土流信息有限公司 版权所有 关于地信 联系方式 邮箱登陆

湘公网安备 43010302000511号

Powered by Discuz! X3.2

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