创建V形的Lisp例程
你好在哪里可以找到lisp例程来创建在戈尔岛或中央岛上使用的V形。 我认为CadTools有一个V形特征。 有一个发挥这个没有真正完成，但。
; chevron island creater
; this use the extrim command to trim shape
; By Alan H Jan 2012
(defun C:Chevron ( / obj pt1 pt2 pt3 pt4 newpt1 newpt2 )
(acet-error-init (list
(list "cmdecho" 0
"highlight" 0
"regenmode" 1
"osmode" 0
"ucsicon" 0
"offsetdist" 0
"attreq" 0
"plinewid" 0
"plinetype" 1
"gridmode" 0
"celtype" "CONTINUOUS"
"ucsfollow" 0
"limcheck" 0
)
T ;flag. True means use undo for error clean up.
'(if redraw_it (redraw na 4))
);list
);acet-error-init
(setq obj (car (entsel "\nPick pline or circle")))
; should do a object test here
(setq whatis (cdr (assoc 0 (entget obj))))
(if (= whatis "LWPOLYLINE")
(princ)
(progn
(princ "\You have picked something other than a polyline ")
(princ "\Remake into a pline and do again ")
(setq dummy (getstring "\press any key"))
(exit)
) ; progn
) ; if
(setq pt1 (Getpoint "\nPick Line start point"))
(setq pt2 (Getpoint pt1 "\nPick end point"))
(command "line" pt1 pt2 "")
(setq gap1 (getreal "\nenter spacing 1"))
(setq gap2 (getreal "\nenter spacing 2"))
(setq pt3 (getpoint "\nPick 1st cross point"))
(setq pt4 (getpoint pt3 "\nPick 2nd cross point"))
(setq dist (distance pt3 pt4))
(setq x (fix (/ dist (+ gap1 gap2))))
(setq newpt1 (strcat (rtos gap1 2 2) ",0.0"))
(setq newpt2 (strcat (rtos gap2 2 2) ",0.0"))
(repeat x
(command "copy" "L" "" "0,0" newpt1)
(command "copy" "L" "" "0,0" newpt2)
)
(load "Extrim")
(etrim obj pt1)
(acet-error-restore)
) ; end defun
(princ)
在下面的可读版本中，Maunsel显然是澳大利亚阿德莱德的一家非常大的工程公司。不确定是否会向公众发布。
; removed as I dont want to be sued by Maunsell's
谢谢您的回复，并更改为可读版本bigal先生。
但实际上 我现在明白了，我不在乎毛塞尔。
页:
[1]