社区 › Auto Lisp › 直线上最近的点

LISP2LEARN 发表于 2022-7-6 07:58:39

直线上最近的点

我前阵子从李那里得到了这个代码，它工作得很好，但我需要做一些调整，我不知道怎么做。我可以理解代码，但修改它对我来说是一项艰巨的任务。我所需要的是：如果块名为“Block1”，将线放在“Layer1”的层上，“Block2”到“Layer2”层上。
再次感谢。
 
 
 
;;;by lee-mac ;;nearest point on a line
(defun c:test ( / d1 d2 el en in l1 l2 p2 p3 ss )
   (if (setq ss (ssget '((0 . "INSERT,LINE"))))
       (progn
         (repeat (setq in (sslength ss))
               (setq en (ssname ss (setq in (1- in)))
                     el (entget en)
               )
               (if (eq "LINE" (cdr (assoc 0 el)))
                   (setq l1 (cons en l1))
                   (setq l2 (cons (trans (cdr (assoc 10 el)) en 0) l2))
               )
         )
         (foreach p1 l2
               (setq p2 (vlax-curve-getclosestpointto (car l1) p1)
                     d1 (distance p1 p2)
               )
               (foreach en (cdr l1)
                   (setq p3 (vlax-curve-getclosestpointto en p1)
                         d2 (distance p1 p3)
                   )
                   (if (< d2 d1) (setq d1 d2 p2 p3))
               )
               (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
         )
       )
   )
   (princ)
)
(vl-load-com) (princ)

BIGAL 发表于 2022-7-6 08:17:05

不精确，但给出了需要“if a block”并使用assoc 2=块名的想法
 
(if (eq "LINE" (cdr (assoc 0 el)))
                   (setq l1 (cons en l1))
(if (eq "INSERT" (cdr (assoc 0 el)))
                   (setq blockname (cdr (assoc 2 el)))
then you need to find out block "2" so can do a (setvar "clayer" "layer2")
)

You need a end of text as numbers 01 etc lisp do it as a defun in main code I need this also Lee I think has a routine for this.

Lee Mac 发表于 2022-7-6 08:24:43

稍微调整一下：
 
;; Nearest point on a line-Lee Mac

(defun c:test ( / d1 d2 el en in l1 l2 la p2 p3 ss )
   (if (setq ss (ssget '((0 . "INSERT,LINE"))))
       (progn
         (repeat (setq in (sslength ss))
               (setq en (ssname ss (setq in (1- in)))
                     el (entget en)
               )
               (if (eq "LINE" (cdr (assoc 0 el)))
                   (setq l1 (cons en l1))
                   (setq l2 (cons (list (trans (cdr (assoc 10 el)) en 0) (cdr (assoc 2 el))) l2))
               )
         )
         (foreach p1 l2
               (setq la (cadr p1)
                     p1 (carp1)
                     p2 (vlax-curve-getclosestpointto (car l1) p1)
                     d1 (distance p1 p2)
               )
               (foreach en (cdr l1)
                   (setq p3 (vlax-curve-getclosestpointto en p1)
                         d2 (distance p1 p3)
                   )
                   (if (< d2 d1) (setq d1 d2 p2 p3))
               )
               (entmake
                   (list
                      '(0 . "LINE")
                     (cons 8 (vl-string-subst "Layer" "Block" la))
                     (cons 10 p1)
                     (cons 11 p2)
                   )
               )
         )
       )
   )
   (princ)
)
(vl-load-com) (princ)

LISP2LEARN 发表于 2022-7-6 08:36:10

太棒了效果完美。再次感谢Bigal&Lee。
 

Lee Mac 发表于 2022-7-6 08:40:56

非常欢迎你学习，我希望我的修改是明确的

LISP2LEARN 发表于 2022-7-6 08:53:57

是的，很清楚。我可以理解你的代码，但我认为我不能在不久的将来编写这样的代码，或者可能永远不会。为我剖析代码是学习lisp的最好方法。谢谢李。
 
 

Lee Mac 发表于 2022-7-6 09:03:28

 
永不言败！你永远不知道你能做什么！

查看完整版本: 直线上最近的点