如何编写

BillyWonka · 发表于 2022-7-6 06:28:22

我是一个完全的新手，因此我需要您在AutoLisp中编写函数方面的指导。

我该如何编写通过单击绘制这些特定图形的函数

marko_ribar · 发表于 2022-7-6 06:42:41

看看是否可以：


(defun c:smiley ( / makecircle p r c1 c2 c3 c4 p1 p2 ll ur )
 (setq p (getpoint "\nPick center point : "))
 (setq r (getdist p "\nSpecify radius : "))
 (defun makecircle ( c r )
   (entmakex
     (list
      '(0 . "CIRCLE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbCircle")
       (cons 10 (trans c 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cons 40 r)
       (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
     )
   )
 )
 (setq c1 (makecircle p r))
 (setq c2 (makecircle p (* r 0.9)))
 (vl-cmdf "_.-hatch" "S" (ssadd c1 (ssadd c2 (ssadd))) "" "P" "S" "")
 (setq c3 (makecircle (polar p (* 3.0 (/ pi 4.0)) (* r 0.5)) (* r 0.15)))
 (setq c4 (makecircle (polar p (* 1.0 (/ pi 4.0)) (* r 0.5)) (* r 0.15)))
 (vl-cmdf "_.-hatch" "S" c3 "" "P" "S" "")
 (vl-cmdf "_.-hatch" "S" c4 "" "P" "S" "")
 (setq p1 (polar (polar p (* 3.0 (/ pi 2.0)) (* r 0.4)) pi (* r 0.6)))
 (setq p2 (polar (polar p (* 3.0 (/ pi 2.0)) (* r 0.4)) 0.0 (* r 0.6)))
 (setq ll (polar p1 (* 3.0 (/ pi 2.0)) (* r 0.05)))
 (setq ur (polar p2 (/ pi 2.0) (* r 0.05)))
 (vl-cmdf "_.rectangle" ll ur)
 (vl-cmdf "_.-hatch" "S" (entlast) "" "P" "S" "")
 (princ)
)

copy


(defun c:wheel ( / makecircle p r c1 c2 c3 ch3 c4 ch4 c5 ch5 c6 ch6 ss )
 (setq p (getpoint "\nPick center point : "))
 (setq r (getdist p "\nSpecify radius : "))
 (defun makecircle ( c r )
   (entmakex
     (list
      '(0 . "CIRCLE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbCircle")
       (cons 10 (trans c 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cons 40 r)
       (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
     )
   )
 )
 (setq c1 (makecircle p r))
 (setq c2 (makecircle p (* r 0.))
 (vl-cmdf "_.-hatch" "S" (ssadd c1 (ssadd c2 (ssadd))) "" "P" "S" "")
 (setq c3 (makecircle (polar p 0.0 (* r 0.3)) (* r 0.1)))
 (setq c4 (makecircle (polar p 0.0 (* r 0.5)) (* r 0.1)))
 (setq c5 (makecircle (polar p 0.0 (* r 0.7)) (* r 0.1)))
 (setq c6 (makecircle (polar p 0.0 (* r 1.1)) (* r 0.1)))
 (vl-cmdf "_.-hatch" "S" c3 "" "P" "S" "")
 (setq ch3 (entlast))
 (vl-cmdf "_.-hatch" "S" c4 "" "P" "S" "")
 (setq ch4 (entlast))
 (vl-cmdf "_.-hatch" "S" c5 "" "P" "S" "")
 (setq ch5 (entlast))
 (vl-cmdf "_.-hatch" "S" c6 "" "P" "S" "")
 (setq ch6 (entlast))
 (setq ss (ssadd))
 (ssadd c3 ss)
 (ssadd c4 ss)
 (ssadd c5 ss)
 (ssadd c6 ss)
 (ssadd ch3 ss)
 (ssadd ch4 ss)
 (ssadd ch5 ss)
 (ssadd ch6 ss)
 (vl-cmdf "_.-array" ss "" "P" p 8 "" "")
 (princ)
)

M.R。

BillyWonka · 发表于 2022-7-6 06:48:29

你太棒了。非常感谢。

marko_ribar · 发表于 2022-7-6 07:02:40

或者，如果您喜欢将其用作块：

copy


(defun c:smiley ( / makecircle p r c1 c2 c3 c4 p1 p2 ll ur sss )
 (setq p (getpoint "\nPick center point : "))
 (setq r (getdist p "\nSpecify radius : "))
 (setq sss (ssadd))
 (defun makecircle ( c r )
   (entmakex
     (list
      '(0 . "CIRCLE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbCircle")
       (cons 10 (trans c 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cons 40 r)
       (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
     )
   )
 )
 (setq c1 (makecircle p r))
 (setq c2 (makecircle p (* r 0.9)))
 (ssadd c1 sss)
 (ssadd c2 sss)
 (vl-cmdf "_.-hatch" "S" (ssadd c1 (ssadd c2 (ssadd))) "" "P" "S" "")
 (ssadd (entlast) sss)
 (setq c3 (makecircle (polar p (* 3.0 (/ pi 4.0)) (* r 0.5)) (* r 0.15)))
 (setq c4 (makecircle (polar p (* 1.0 (/ pi 4.0)) (* r 0.5)) (* r 0.15)))
 (ssadd c3 sss)
 (ssadd c4 sss)
 (vl-cmdf "_.-hatch" "S" c3 "" "P" "S" "")
 (ssadd (entlast) sss)
 (vl-cmdf "_.-hatch" "S" c4 "" "P" "S" "")
 (ssadd (entlast) sss)
 (setq p1 (polar (polar p (* 3.0 (/ pi 2.0)) (* r 0.4)) pi (* r 0.6)))
 (setq p2 (polar (polar p (* 3.0 (/ pi 2.0)) (* r 0.4)) 0.0 (* r 0.6)))
 (setq ll (polar p1 (* 3.0 (/ pi 2.0)) (* r 0.05)))
 (setq ur (polar p2 (/ pi 2.0) (* r 0.05)))
 (vl-cmdf "_.rectangle" ll ur)
 (ssadd (entlast) sss)
 (vl-cmdf "_.-hatch" "S" (entlast) "" "P" "S" "")
 (ssadd (entlast) sss)
 (vl-cmdf "_.copybase" p sss "")
 (vl-cmdf "_.erase" sss "")
 (vl-cmdf "_.pasteblock" p)
 
 (princ)
)

copy


(defun c:wheel ( / makecircle p r c1 c2 c3 ch3 c4 ch4 c5 ch5 c6 ch6 ss sss e )
 (setq p (getpoint "\nPick center point : "))
 (setq r (getdist p "\nSpecify radius : "))
 (setq sss (ssadd))
 (defun makecircle ( c r )
   (entmakex
     (list
      '(0 . "CIRCLE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbCircle")
       (cons 10 (trans c 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cons 40 r)
       (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
     )
   )
 )
 (setq c1 (makecircle p r))
 (setq c2 (makecircle p (* r 0.))
 (ssadd c1 sss)
 (ssadd c2 sss)
 (vl-cmdf "_.-hatch" "S" (ssadd c1 (ssadd c2 (ssadd))) "" "P" "S" "")
 (ssadd (entlast) sss)
 (setq c3 (makecircle (polar p 0.0 (* r 0.3)) (* r 0.1)))
 (ssadd c3 sss)
 (setq c4 (makecircle (polar p 0.0 (* r 0.5)) (* r 0.1)))
 (ssadd c4 sss)
 (setq c5 (makecircle (polar p 0.0 (* r 0.7)) (* r 0.1)))
 (ssadd c5 sss)
 (setq c6 (makecircle (polar p 0.0 (* r 1.1)) (* r 0.1)))
 (ssadd c6 sss)
 (vl-cmdf "_.-hatch" "S" c3 "" "P" "S" "")
 (setq ch3 (entlast))
 (ssadd ch3 sss)
 (vl-cmdf "_.-hatch" "S" c4 "" "P" "S" "")
 (setq ch4 (entlast))
 (ssadd ch4 sss)
 (vl-cmdf "_.-hatch" "S" c5 "" "P" "S" "")
 (setq ch5 (entlast))
 (ssadd ch5 sss)
 (vl-cmdf "_.-hatch" "S" c6 "" "P" "S" "")
 (setq ch6 (entlast))
 (ssadd ch6 sss)
 (setq ss (ssadd))
 (ssadd c3 ss)
 (ssadd c4 ss)
 (ssadd c5 ss)
 (ssadd c6 ss)
 (ssadd ch3 ss)
 (ssadd ch4 ss)
 (ssadd ch5 ss)
 (ssadd ch6 ss)
 (setq e ch6)
 (vl-cmdf "_.-array" ss "" "P" p 8 "" "")
 (while (setq e (entnext e))
   (ssadd e sss)
 )
 (vl-cmdf "_.copybase" p sss "")
 (vl-cmdf "_.erase" sss "")
 (vl-cmdf "_.pasteblock" p)
 (princ)
)

M.R。

neophoible · 发表于 2022-7-6 07:05:09

伙计们，做得很好。不过，我确实有一个问题。对于一个完全的新手来说，创建块，然后使用一个非常简单的例程插入块，不管它是什么，不是更好吗？这样，当他想出更多符号时，他只需创建另一个块，然后复制并编辑新符号的例程。

pBe · 发表于 2022-7-6 07:17:06

我想不出所要求的程序有什么实际用途。可能是学校的家庭作业。

pBe · 发表于 2022-7-6 07:28:26

播放时间：

copy

(Defun c:wheel  (/ LWPoly p pt r r2 x donuts)
     (defun LWPoly  (lst)
           (entmakex
                 (append (list (cons 0 "LWPOLYLINE")
                               (cons 100 "AcDbEntity")
                               (cons 100 "AcDbPolyline")
                               (cons 90 (length lst))
                               (cons 70 1))
                         (mapcar (function (lambda (p) (cons 10 p)))
                                 lst))))
     (setq p  (getpoint "\nPick center point : ")
           pt p)
     (setq r  (getdist p "\nSpecify radius : ")
           r2 r)
     (setq donuts (ssadd))
     (setq r (/ r 4.0))
     (repeat 5
           (setq p (polar p 0 r))
           (setq pl   (LWPoly (list (polar p 0 (setq x (/ r 4.0)))
                                    (polar p 0 (* x 3)))))
           (ssadd pl donuts)
           (vla-setbulge (setq pl (vlax-ename->vla-object pl)) 0 1.0)
           (vla-setbulge pl 1 1.0)
           (vla-put-ConstantWidth pl r)
           )
     (entdel (ssname donuts 3))
     (ssdel (ssname donuts 3) donuts)
     (setq pl (LWPoly (list (polar p pi (* r 0.5))
                            (polar pt pi (+ (* r 0.5) r2)))))
     (vla-setbulge (setq pl (vlax-ename->vla-object pl)) 0 1.0)
     (vla-setbulge pl 1 1.0)
     (vla-put-ConstantWidth pl r)
     (command "_-array" donuts "" "_polar" pt 8 360 "_yes")
     (princ)
     )

neophoible · 发表于 2022-7-6 07:32:33

是的，我也不能，所以HW/Test/Exam很可能。坦率地说，这听起来像是AutoCAD的新手。单击一次是不现实的，因为您通常希望在调用例程后至少选择一个插入点。我很感兴趣的是，这样的查询得到的回复是“在你展示你已经做过的事情之前，我不会帮你”，在这里，让我完全为你做，而无需进一步输入”，在这种情况下，提供了两个版本！

[编程交流] 如何编写

发表回复

精选推荐