地信网论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

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

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

查看: 105|回复: 1
收起左侧

[二次开发] 多线段继续lsp

[复制链接]

3

主题

180

铜板

0

好友

技术员

Rank: 3Rank: 3

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

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

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

x
本帖最后由 wzg 于 2018-11-26 17:48 编辑

;wzg 修改于20150417
(defun c:pljx  ( / ss en enl ContinuePL oldce)
;;<a href=\"http://bbs.mjtd.com/thread-107695-2-1.html\"
;;by edata
(defun ContinuePL (en / obj end_pt pt c_flag n ch_start ch_close ch_open )
  (vl-load-com)
  (if en
    (progn      
      (setq obj (vlax-ename->vla-object en)
            ch_close nil
            ch_start nil
;;;            ch_open nil
            )
      (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
      (while (and (not ch_close)
                  (car (list t (initget "S E C O _start end close open" )));永远返回t
                  (setq pt (getpoint end_pt "\n指定下一点[S从起点开始/E从终点开始/C闭合/O打开]:"))
             )
        (cond
          ((= (type pt) 'list)
     (setq pt(trans pt 1 0))
           (if (vlax-curve-isClosed obj)
             (setq n (fix (1- (vlax-curve-getendParam obj)))
                   c_flag t
             )
             (setq n (fix (vlax-curve-getendParam obj))
                   c_flag nil
             )
           )
           (if (or ch_start c_flag )
             (progn
               (vla-addvertex  obj  0
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbDouble '(0 . 1))
                   (list (car pt) (cadr pt))
                 )
               )
               (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
             )
             (progn
               (vla-addvertex  obj (1+ n)
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbDouble '(0 . 1))
                   (list (car pt) (cadr pt))
                 )
               )
               (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
             )
           )
          )
          ((and (= (type pt) 'str)(= pt "start"))
           (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
           (setq ch_start t)
           )
          ((and (= (type pt) 'str)(= pt "end"))
           (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
           (setq ch_start nil)           
           )
          ((and (= (type pt) 'str)(= pt "close"))
           (if (not(vlax-curve-isClosed obj))
             (vla-put-closed obj 1))
           (setq ch_close t)           
           )
          ((and (= (type pt) 'str)(= pt "open"))
           (if (vlax-curve-isClosed obj)
             (vla-put-closed obj 0))
;;;           (setq ch_open t)           
           )
        )
      )
    )
  )
)
;-----------------------
;(while (not(setq ss (ssget ":E:S" '((0 . "*OLYLINE"))))))
;(setq en (ssname ss 0))
(setvar "cmdecho" 0)
(princ "\n功能:多线段或直线继续画,直线则转为多线段")
(initget "  ")
(setq en (entsel "\n点击多线段或直线继续画..."))
(cond
        ((= en "")nil)
        ((and (setq en (car en))
              (setq enl (entget en))
                (member (cdr(assoc 0 enl))(list "POLYLINE" "LWPOLYLINE" "LINE"))
        )
        (cond
                ((and(wcmatch(cdr(assoc 0 enl))"POLYLINE")
                (= (cdr(assoc 70 enl)) 4)
                (or (= (cdr(assoc 75 enl)) 5) (= (cdr(assoc 75 enl)) 6))
                )
                (command "pedit" en "d" "")
                (ContinuePL en)
                (command "pedit" en "s" "")
                (setvar "cmdecho" 1)
                )
                ((and (wcmatch(cdr(assoc 0 enl))"POLYLINE")               
                (= (cdr(assoc 70 enl)) 2)
                (= (cdr(assoc 75 enl)) 0)
                )
                (command "pedit" en "d" "")
                (ContinuePL en)
                (command "pedit" en "f" "")
                (setvar "cmdecho" 1)
                )
                ((wcmatch(cdr(assoc 0 (entget en)))"LWPOLYLINE")
                        (ContinuePL en)
                )
                ((wcmatch(cdr(assoc 0 (entget en)))"LINE")
                        (setq oldce (getvar "PEDITACCEPT"))
                         (setvar "PEDITACCEPT" 1)
                         (command "pedit" en "W" "0" "")
                         (setvar "PEDITACCEPT" oldce)
                         (setvar "cmdecho" 1)
                         (setq en (entlast))
                        (ContinuePL en)
                )
        ))
        (t (c:pljx))
)
(princ)
)       

0

主题

517

铜板

1

好友

技术员

Rank: 3Rank: 3

积分
76
发表于 2018-11-29 09:14 | 显示全部楼层
真是6啊!!!
回复

使用道具 举报

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

本版积分规则

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

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

湘公网安备 43010302000511号

Powered by Discuz! X3.2

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