社区 › Auto Lisp › 自动创建多段线

rk25134 发表于 2022-7-6 00:22:42

是的，你的日常工作做得很好。左侧也需要相同。

Tharwat 发表于 2022-7-6 00:25:46

 
没问题，除了双方都有一个选择之外，还有一个对双方都有效的选择。
 
试试看，让我知道。。。
 

(defun c:Test (/ leg _LW ss lt rt k)
;;    Tharwat 06. jan. 2014    ;;
(defun leg (x e) (cdr (assoc x (entget e))))
(defun _LW (pts)
   (entmakex (append (list '(0 . "LWPOLYLINE")
                           '(100 . "AcDbEntity")
                           '(100 . "AcDbPolyline")
                           (cons 90 (length pts))
                           '(70 . 0)
                     )
                     (mapcar (function (lambda (p) (cons 10 (list (car p) (cadr p))))) pts)
             )
   )
)
(princ "\n Select Dimensions ...")
(if (setq ss (ssget '((0 . "*DIMENSION"))))
   (progn ((lambda (i / sn a b)
             (while (setq sn (ssname ss (setq i (1+ i))))
               (if (< (car (setq a (leg 13 sn))) (car (setq b (leg 14 sn))))
               (setq rt (cons b rt)
                     lt (cons a lt)
               )
               (setq rt (cons a rt)
                     lt (cons b lt)
               )
               )
             )
         )
            -1
          )
          (if (and (> (length lt) 1) (> (length rt) 1))
            (if (progn (initget 6 "Left Right Both")
                     (setq k (cond ((getkword (strcat "\n Specify a side < "
                                                      (cond (*side*)
                                                            ((setq *side* "Left"))
                                                      )
                                                      " > :"
                                                )
                                    )
                                     )
                                     (*side*)
                               )
                     )
                )
            (cond ((eq k "Left") (mapcar '_LW (list (vl-sort lt '(lambda (p q) (< (cadr p) (cadr q)))))))
                  ((eq k "Right") (mapcar '_LW (list (vl-sort rt '(lambda (p q) (< (cadr p) (cadr q)))))))
                  (t
                     (mapcar '_LW
                           (list (vl-sort lt '(lambda (p q) (< (cadr p) (cadr q))))
                                 (vl-sort rt '(lambda (p q) (< (cadr p) (cadr q))))
                           )
                     )
                  )
            )
            )
            (princ "\n <!> You should select two dimensions at least <!> ")
          )
   )
)
(princ)
)

pBe 发表于 2022-7-6 00:29:01

我想实际的绘图会比你发布的rk25134更复杂，你能发布一个更真实的绘图样本吗。
 
 

rk25134 发表于 2022-7-6 00:32:23

工作正常

rk25134 发表于 2022-7-6 00:36:33

任何其他Lisp程序

Tharwat 发表于 2022-7-6 00:38:07

 
 
既然它工作得很好，那么有什么必要要求另一个lisp？

rk25134 发表于 2022-7-6 00:41:14

请查看随附的屏幕截图。我使用了最新的例程，并从lisp中输入right选项

Tharwat 发表于 2022-7-6 00:44:57

我做了你的第一个附加图纸的工作。

Tharwat 发表于 2022-7-6 00:50:08

如果你对这条线再粗心，请告诉我。

查看完整版本: 自动创建多段线