获取交点和dr

jasonle215 · 发表于 2022-7-5 18:45:49

大家好，

我正在使用autocad 2010，是autolisp的新手，希望你们能帮我一把。

如果我有一系列水平线和一条垂直线（如下面附上的第一张照片）。

如何生成autolisp命令，让我选择红线，然后选择所有水平线，然后它将绘制矩形，长度是用户输入，高度是黑线之间的距离。该程序还需要计算出红线和黑线的交点，以将矩形的角放置在交点处（间隙请参见图2）

谢谢你的提示

Tharwat · 发表于 2022-7-5 19:02:11

欢迎来到CADTutor。

试试这个程序，让我知道。

copy


Removed due to ignorance from the OP

jasonle215 · 发表于 2022-7-5 19:17:48

对不起，朋友，论坛的通知被发送到我的垃圾邮件。如果你不介意的话，你能再次上传代码吗？我真的很抱歉，我不是有意忽视这个帖子的。

BIGAL · 发表于 2022-7-5 19:31:31

这可以通过使用ssget和围栏方法来完成，这将以正确的顺序选择交叉线，因此您可以构建矩形（setq ss（ssget“F”（list pt1 pt2）），pt1 pt2来自红线，目前需要一些时间繁忙。

copy


(defun c:rectangs ( / tpp1 pt1 pt2 intpt1 intpt2 intpt3 intpt4 ss)
(setq width (getreal "enter width"))
(setq obj (entsel "pick crossing line"))
(setq obj2 (vlax-ename->vla-object (car obj))) ;convert pick line to vl object
(setq tpp1 (entget (car obj) ) )
(setq pt1 (cdr (assoc 10 tpp1) ) ) 
(setq pt2 (cdr (assoc 11 tpp1) ) )
(setq ss (ssget "F" (list pt1 pt2)))
(setq x (- (sslength ss)1))
(setq obj1 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(repeat (sslength ss)
(setq obj3 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq intpt2 (vlax-invoke obj2 'intersectWith obj3 acExtendThisEntity))
(setq intpt3 (polar intpt1 0.0 width))
(setq intpt4 (polar intpt2 0.0 width))
(command "pline" intpt1 intpt2 intpt3 intpt4 "C")
(setq intpt1 intpt2)
) ; repeat
)

jasonle215 · 发表于 2022-7-5 19:36:14

嗨，比格尔，

谢谢你的代码。我只是想知道，使用（ssget“F”），它将考虑所有与垂直线相交的水平线。有没有办法调整代码，只允许您选择要在其中创建矩形的特定水平线？

BIGAL · 发表于 2022-7-5 19:52:35

我以为你想做的都是，问题是，需要反复做拣两条线，这样矩形之间就可以画出拣对，中间也可以有一条线。两条线使用entsel的不同方法。也许选择第一个点，然后perp top pt，然后选择两条线？保存绘制直线。Ps我画了一条弯曲的线，它仍然有效！

copy


(defun c:rectangs2 ( / tpp1 pt1 pt2 intpt1 intpt2 intpt3 intpt4 ss)
(if (not AH:getval) (load "getval"))
(ah:getval "Enter width.." "     edit_width = 10;" "     edit_limit = 8;")
(setq width (Atof item))
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point"))
(command "line" pt1 pt2 "")
(setq obj (entlast))
(setq obj2 (vlax-ename->vla-object obj)) ;convert pick line to vl object
(alert "Pick 2 lines press Enter to exit on 1st line")
(while
(setq obj1 (vlax-ename->vla-object (car (entsel "pick 1st line"))))
(setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(setq obj3 (vlax-ename->vla-object (car (entsel "pick 2nd line"))))
(setq intpt2 (vlax-invoke obj2 'intersectWith obj3 acExtendThisEntity))
(setq intpt3 (polar intpt1 0.0 width))
(setq intpt4 (polar intpt2 0.0 width))
(command "pline" intpt1 intpt2 intpt3 intpt4 "C")
(vla-delete obj2)
) ; while
)

你也需要这个

copy


;; Input  Dialog box with variable title
;; By Ah June 2012
;; code (ah:getval title)
(defun AH:Getval (title width limit / fo)
(setq fname "C://acadtemp//getval.dcl")
(setq fo (open fname "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) "sizze" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo)
; these can be replaced with shorter value etc
;(write-line "     edit_width = 18;" fo) 
;(write-line "     edit_limit = 15;" fo)
(write-line width fo) 
(write-line limit fo)
(write-line "   is_enabled = true;" fo)        
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "ok_cancel;}" fo)
(close fo)
(setq dcl_id (load_dialog  "c:\\getval")) ; make this a directory of your choosing
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(action_tile "sizze" "(setq item  $value)(done_dialog)")
(mode_tile "sizze" 3)
(start_dialog)
; returns the value of item
)

[编程交流] 获取交点和dr

发表回复

精选推荐