用简单lisp程序编制

用简单lisp程序编制,第1张

(defun c:zfx(/ A ANG p1 p2 p3 p4 p5 os cmd)

(SETQ CMD (GETVAR "cmdecho"))

(SETVAR "cmdecho" 0)

(setq os (getvar "osmode"))

(setq A (getreal"\n:输入边长"))

(setq ANG (getreal"\n:输入角度"))

setq r (getreal"\n:输入半径"))

(setq p1 (getpoint"\n:指定起点"))

(setvar "osmode" 0)

(setq p2 (polar p1 (* pi (/ ANG 180)) A))

(setq p3 (polar p2 (* pi (+ 0.5 (/ ANG 180))) A))

(setq p4 (polar p1 (* pi (+ 0.5 (/ ANG 180))) A))

(command "pline" p1 p2 p3 p4 "c")

(SETQ p5 (polar p1 (+ (* pi (/ ANG 180)) (* 0.25 pi)) (* A (sin (/ pi 4)))))

(command "circle" p5 r)

(setvar "osmode" os)

(SETVAR "cmdecho" CMD)

(PRINC)

)

(entmake '((0 . "INSERT")))

中间用LISP的(entmake (list......))或者调用CAD命令(command "具体命令" "该命令所需要的数据或者选项") 绘制你需要制作成块的图元,可以有很多个

至于你说的要一个矩形,简单起见可以用(COMMAND "rectangle“(getpoint)(getpoint))来完成它

(entmake '((0 . "SEQEND"))

最后的代码就是

entmake '((0 . "INSERT")))

(COMMAND "rectangle“(getpoint)(getpoint))

(entmake '((0 . "SEQEND"))

代码如下:

(defun c:tes ( / &k1 &kw1 ss1)

 (vl-load-com)

 (princ "\n请选择封闭多段线")

 (if (setq &kw1 (ssget '((0 . "LWPOLYLINE") (70 . 1))))

  (progn

   (setq ss1 '())

   (while (setq &k1 (ssname &kw1 0))

    (setq &kw1 (ssdel &k1 &kw1) ss1 (cons &k1 ss1))

   )while

   (mapcar 'w1711202 ss1)

  )

 )

 (princ)

)

处理图元

(defun w1711202 (obj / ang1 ang2 dis1 n obj p1 p2 p3 p4 ss1 ss2 x y)

 (setq n (vlax-curve-getEndParam obj) ss1 '())

 (while (> n -1) (setq ss1 (cons n ss1) n (- n 1)) )

 (setq ss2 (mapcar '(lambda (x) (vlax-curve-getDistAtParam obj x)) ss1)

       n (caar (vl-sort (mapcar 'list ss1 (mapcar '- (cdr ss2) ss2)) '(lambda (x y) (> (cadr x) (cadr y)))))

       p1 (vlax-curve-getPointAtParam obj n)

       p2 (vlax-curve-getPointAtParam obj (1+ n))

       ang1 (angle p1 p2)

       ang2 (+ ang1 (* pi 0.5))

       ss1 (mapcar '(lambda (x) (vlax-curve-getPointAtParam obj x)) ss1)

       ss1 (car (vl-sort (mapcar '(lambda (x) (list (distance (inters p1 p2 x (polar x ang2 20) nil) x) x)) ss1) '(lambda (x y) (> (car x) (car y)))))

       dis1 (car ss1)

       p4 (cadr ss1)

       p3 (inters p1 p2 p4 (polar p4 ang2 20) nil)

       ang2 (angle p3 p4)

       ss1 (mapcar '(lambda (x) (cons 10 x)) (list p1 p2 (polar p2 ang2 dis1) (polar p1 ang2 dis1)))

       ss1 (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(43 . 0) '(38 . 0)) ss1)

 )

 (entmake ss1)

)


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12023262.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-20
下一篇 2023-05-20

发表评论

登录后才能评论

评论列表(0条)

保存