等分连线

Lispboy · 发表于 2020-5-13 17:52:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

本帖最后由 newer 于 2020-5-13 19:25 编辑

有选项，对于多段线，可以按每个子段进行等分
全局等分4段和子段等分4段的区别

搜狗截图20200513192342.jpg

(defun c:xdtb_divconnect (/ e1 e2 p1 p2 pts2 pts2 dis1 dis2)
(defun _pnts (pts tf)
(if tf
(setq pts (reverse pts))
)
pts
)
(if (not #xd-var-global-divide)
(setq #xd-var-global-divide 4)
)
(if (setq
v (getint
(xdrx-prompt "\n输入等分数<" #xd-var-global-divide ">:" t)
)
)
(setq #xd-var-global-divide v)
)
(xdrx-initget "Y N")
(setq yno (xdrx-yesorno "\n是否多段线按段等分" 0))
(if (and (setq e1 (xdrx-entsel
(xdrx-prompt
"\n拾取第一条"
(cond ((= yno 1) "多段线")
(t "曲线")
)
"的一端<退出>:"
t
)
(cond ((= yno 1) '((0 . "*polyline")))
(t '((0 . "*line,arc")))
)
)
)
(setq p1 (cadr e1))
(setq e1 (car e1))
(setq e2 (xdrx-entsel
(xdrx-prompt
"\n拾取第二条"
(cond ((= yno 1) "多段线")
(t "曲线")
)
"对应的一端<退出>:"
t
)
(cond ((= yno 1) '((0 . "*polyline")))
(t '((0 . "*line,arc")))
)
)
)
(setq p2 (cadr e2))
(setq e2 (car e2))
)
(progn
(xdrx-begin)
(if (and (= yno 1)
(/= (length (xdrx-getpropertyvalue e1 "allsegs"))
(length (xdrx-getpropertyvalue e2 "allsegs"))
)
)
(progn
(xdrx-prompt
"\n选择了多段线局部等分连线，但检测到两条曲线的子段数不同，不能操作，请核查."
)
(vl-exit-with-value 0)
)
)
(setq pts1 (xdrx-getpropertyvalue
e1
"divide"
#xd-var-global-divide
(cond ((= yno 1) t)
(t nil)
)
)
pts1 (xd::list:flat-point pts1)
pts2 (xdrx-getpropertyvalue
e2
"divide"
#xd-var-global-divide
(cond ((= yno 1) t)
(t nil)
)
)
pts2 (xd::list:flat-point pts2)
dis1 (xdrx-curve-getdistatpoint e1 p1)
dis2 (- (xdrx-getpropertyvalue e1 "length") dis1)
pts1 (_pnts pts1 (> dis1 dis2))
dis1 (xdrx-curve-getdistatpoint e2 p2)
dis2 (- (xdrx-getpropertyvalue e2 "length") dis1)
pts2 (_pnts pts2 (> dis1 dis2))
)
(mapcar '(lambda (x)
(xdrx-line-make x)
(xdrx-entity-setpropertiesfrom (entlast) e1)
)
(mapcar '(lambda (x y) (list x y)) pts1 pts2)
)
(xdrx-end)
)
)
(princ)
)

(defun c:xdtb_divconnect (/ e1 e2 p1 p2 pts2 pts2 dis1 dis2) 
  (defun _pnts (pts tf) 
    (if        tf 
      (setq pts (reverse pts)) 
    ) 
    pts 
  ) 
  (if (not #xd-var-global-divide) 
    (setq #xd-var-global-divide 4) 
  ) 
  (if (setq 
        v (getint 
            (xdrx-prompt "\n输入等分数<" #xd-var-global-divide ">:" t) 
          ) 
      ) 
    (setq #xd-var-global-divide v) 
  ) 
  (xdrx-initget "Y N") 
  (setq yno (xdrx-yesorno "\n是否多段线按段等分" 0)) 
  (if (and (setq e1 (xdrx-entsel 
                      (xdrx-prompt 
                        "\n拾取第一条" 
                        (cond ((= yno 1) "多段线") 
                              (t "曲线") 
                        ) 
                        "的一端<退出>:" 
                        t 
                      ) 
                      (cond ((= yno 1) '((0 . "*polyline"))) 
                            (t '((0 . "*line,arc"))) 
                      ) 
                    ) 
           ) 
           (setq p1 (cadr e1)) 
           (setq e1 (car e1)) 
           (setq e2 (xdrx-entsel 
                      (xdrx-prompt 
                        "\n拾取第二条" 
                        (cond ((= yno 1) "多段线") 
                              (t "曲线") 
                        ) 
                        "对应的一端<退出>:" 
                        t 
                      ) 
                      (cond ((= yno 1) '((0 . "*polyline"))) 
                            (t '((0 . "*line,arc"))) 
                      ) 
                    ) 
           ) 
           (setq p2 (cadr e2)) 
           (setq e2 (car e2)) 
      ) 
    (progn 
      (xdrx-begin) 
      (if (and (= yno 1) 
               (/= (length (xdrx-getpropertyvalue e1 "allsegs")) 
                   (length (xdrx-getpropertyvalue e2 "allsegs")) 
               ) 
          ) 
        (progn 
          (xdrx-prompt 
            "\n选择了多段线局部等分连线，但检测到两条曲线的子段数不同，不能操作，请核查." 
          ) 
          (vl-exit-with-value 0) 
        ) 
      ) 
      (setq pts1 (xdrx-getpropertyvalue 
                   e1 
                   "divide" 
                   #xd-var-global-divide 
                   (cond ((= yno 1) t) 
                         (t nil) 
                   ) 
                 ) 
            pts1 (xd::list:flat-point pts1) 
            pts2 (xdrx-getpropertyvalue 
                   e2 
                   "divide" 
                   #xd-var-global-divide 
                   (cond ((= yno 1) t) 
                         (t nil) 
                   ) 
                 ) 
            pts2 (xd::list:flat-point pts2) 
            dis1 (xdrx-curve-getdistatpoint e1 p1) 
            dis2 (- (xdrx-getpropertyvalue e1 "length") dis1) 
            pts1 (_pnts pts1 (> dis1 dis2)) 
            dis1 (xdrx-curve-getdistatpoint e2 p2) 
            dis2 (- (xdrx-getpropertyvalue e2 "length") dis1) 
            pts2 (_pnts pts2 (> dis1 dis2)) 
      ) 
      (mapcar '(lambda (x) 
                 (xdrx-line-make x) 
                 (xdrx-entity-setpropertiesfrom (entlast) e1) 
               ) 
              (mapcar '(lambda (x y) (list x y)) pts1 pts2) 
      ) 
      (xdrx-end) 
    ) 
  ) 
  (princ) 
)

liuwenxuan8351 · 发表于 2020-5-14 12:21:13

感谢楼主分享收藏了

bnjzzheng · 发表于 2020-8-3 20:09:18

感谢楼主分享收藏了

账号		自动登录	找回密码
密码			立即注册

[曲线] 等分连线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。