Question

用lisp代码帮忙写个CAD小程序

像图片这样拾取两点绘制孔的侧试图，其中N2 绘制沉孔的主代码已经有了，可以根据此修改。
已有代码及绘制说明文件在此下载：http://pan.baidu.com/s/1i3n6cJF
详情可以留言或Q聊
谢谢您的帮助！非常感激！
悬赏分不是问题哟，问题解决再增加

Answer 1

(defun c:n3()
(vl-load-com)
(setq cm (getvar "cmdecho") os (getvar "osmode"))
(setvar "cmdecho" 0)
(command "_undo" "be")
(setq pdbz nil)
(vlax-for obj (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (= (vla-get-name obj) "ACAD_ISO04W100")
(setq pdbz t)
)
)
(if (= pdbz nil)
(command "_linetype" "l" "镇源知ACAD_ISO04W100" "" "御消")
)
(while (and (setvar "osmode" 33)
(setq pt1 (getpoint "\n请指定PT1<回车结束>:"))
)
(setvar "orthomode" 1)
(if (and (setq pt2 (getpoint pt1 "\n请指定PT2:"))
(setq d (getreal "\n请输入d值:"))
(setq w (getreal "\裂含n请输入w值:"))
)
(progn
(setvar "orthomode" 0) (setvar "osmode" 0)
(setq p1 (mapcar '+ pt2 (list (* 0.5 d) 0.0))
p6 (mapcar '+ pt2 (list (* -0.5 d) 0.0))
p3 (mapcar '+ pt1 (list (* 0.5 w) 0.0))
p4 (mapcar '+ pt1 (list (* -0.5 w) 0.0))
p7 (mapcar '+ pt1 (list 0.0 (* -0.5 w)))
p8 (mapcar '+ pt1 (list (* 0.5 d) 0.0))
p9 (mapcar '+ pt1 (list (* -0.5 d) 0.0))
p2 (inters p1 p8 p3 p7)
p5 (inters p6 p9 p4 p7)
)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(62 . 4) '(90 . 4) '(70 . 1)
(cons 10 p1) (cons 10 p2) (cons 10 p5) (cons 10 p6)
)
)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(62 . 4) '(90 . 4) '(70 . 1)
(cons 10 p2) (cons 10 p3) (cons 10 p4) (cons 10 p5)
)
)
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine")
'(62 . 1) '(6 . "ACAD_ISO04W100") '(48 . 0.01)
(cons 10 (mapcar '+ pt1 '(0 3.0)))
(cons 11 (mapcar '+ pt2 '(0 -3.0)))
)
)
)
)

)
(command "_undo" "e")
(setvar "osmode" os) (setvar "cmdecho" cm)
(princ)
)