种植/树木/曲线

suriwaits · 发表于 2022-7-5 18:42:35

你好

附件是我必须创建的种植边界。

如果任何人有lisp绘制类似的线，并愿意分享，请分享您的代码。

线型无法使用，因为如果需要，我需要稍后填充。

谢谢

PS：我试过mkltype并使用了wmfout和wmfin。形状和曲线之间有间隙。
种植。图纸

BIGAL · 发表于 2022-7-5 19:02:14

Express内置了一个中断例程，您可以从lisp中以某种方式调用它以实现自动化。

suriwaits · 发表于 2022-7-5 19:09:17

感谢Bigal提出的宝贵建议，

Tharwat · 发表于 2022-7-5 19:18:31

试试这个例行程序，它会根据需要完成任务。

注意：不要在多段线的弧段上使用例程，否则会产生意外结果。

copy

(defun c:Test (/ s gr o p a b c d e ang prm pt l f lst)
 ;;        Author        : Tharwat Al Shoufi                ;;
 ;;        Date        : 04. Sep. 2014                        ;;
 (if (and (setq s (entsel "\n Select polyline :"))
          (eq (cdr (assoc 0 (entget (setq o (car s))))) "LWPOLYLINE")
          )
   (progn (while (and (eq (car (setq gr (grread t 15 0))) 5)
                      (not (redraw))
                      (setq p (vlax-curve-getclosestpointto o (cadr gr))
                            a (vlax-curve-getpointatdist o (- (vlax-curve-getdistatpoint o p) (/ 0.1709 2.)))
                            b (vlax-curve-getpointatdist o (+ (vlax-curve-getdistatpoint o p) (/ 0.1709 2.)))
                      )
                      (if (minusp (sin (- (angle a b) (angle b (cadr gr)))))
                        (setq ang (angle b a))
                        (setq ang (angle a b))
                      )
                      (setq c (polar (polar a (+ ang (* pi 0.5)) 0.2103) (angle a b) 0.0341)
                            d (polar p (+ ang (* pi 1.5)) 0.1823)
                            e (polar c (angle a b) 0.1028)
                      )
                 )
            (grvecs (list -2 a c c d d e e b))
          )
          (if (and a b c d e)
            (progn (setq lst nil
                         prm (fix (vlax-curve-getparamatpoint o a))
                         pt  (vlax-curve-getpointatparam o prm)
                   )
                   (foreach itm (entget o)
                     (if (equal itm (setq f (list 10 (car pt) (cadr pt))) 0.0001)
                       (setq lst (cons f lst)
                             lst (cons (list 10 (car a) (cadr a)) lst)
                             lst (cons (list 10 (car c) (cadr c)) lst)
                             lst (cons (list 10 (car d) (cadr d)) lst)
                             lst (cons (list 10 (car e) (cadr e)) lst)
                             lst (cons (list 10 (car b) (cadr b)) lst)
                       )
                       (setq lst (cons itm lst))
                     )
                     (if (eq (car itm) 90)
                       (setq lst (cons (cons 90 (+ (cdr itm) 5)) lst))
                     )
                   )
                   (entmod (reverse lst))
                   (entupd o)
            )
          )
   )
 )
 (redraw)
 (princ)
)(vl-load-com)