装饰设计中的[九厘板]绘图命令
本帖最后由 gbhsu 于 2012-10-20 21:38 编辑绘制九厘板
(defun c:jlb (/ p1 p2 dist ec1 ec2 ec3 ec4 key pt-tmp eh1 eh2 l1-l2 rlt
vrl p-list pt-end)
(command "undo" "group")
(setvar "osmode" 255)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\n输入九厘板第一点："))
(setq p2 (getpoint p1 "\n输入九厘板下一点："))
(setvar "osmode" 0)
(command "line" p1 p2 "")
(setq ang (angle p1 p2))
(setq ang1 (+ ang (* pi 0.5)))
(setq ec (entlast))
(command "change" ec "" "p" "c" 2 "")
(command "line" (polar p1 ang1 9) (polar p2 ang1 9) "")
(setq ec1 (entlast))
(command "change" ec1 "" "p" "c" 2 "")
(setq eh1 (cdr (assoc 5 (entget ec1)))) ;第三条直线的句柄
(setq dist (distance p1 p2)key T )
(setq pt-end (polar p2 ang1 3))
(if (<= dist 39)
(setq key nil)
(progn
(setq pt1 (polar p1 ang1 3)
pt2 (polar pt1 ang 33)
pt3 (polar (polar pt1 ang 30) ang1 -3)
pt4 pt2
pt5 (polar pt4 ang 3)
pt6 (polar pt3 ang 3)
pt7 pt5
pt8 (polar pt7 ang 3)
pt9 (polar pt6 ang 3)
pt10 pt8
pt11 (polar pt7 ang1 3)
pt12 (polar pt11 ang -3)
pt13 pt7
pt14 pt4
pt15 (polar pt12 ang -3)
pt16 (polar pt1 ang1 3)
pt17 pt15
pt18 (polar pt12 ang1 3)
pt19 pt17
pt20 pt12
pt21 (polar pt18 ang 3)
pt22 pt20
pt23 pt11
pt24 (polar pt21 ang 3)
pt25 pt11
pt26 pt10
)
(command ".pline" pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10
pt11 pt12 pt13 pt14 pt15 pt16 pt17 pt18
pt19 pt20 pt21 pt22 pt23 pt24 pt25 pt26)
)
) ;end of if
(while key
(setq pt1 pt26
dist (distance pt1 pt-end)
)
(if (> dist 39)
(progn
(setq
pt2 (polar pt1 ang 33)
pt3 (polar (polar pt1 ang 30) ang1 -3)
pt4 pt2
pt5 (polar pt4 ang 3)
pt6 (polar pt3 ang 3)
pt7 pt5
pt8 (polar pt7 ang 3)
pt9 (polar pt6 ang 3)
pt10 pt8
pt11 (polar pt7 ang1 3)
pt12 (polar pt11 ang -3)
pt13 pt7
pt14 pt4
pt15 (polar pt12 ang -3)
pt16 (polar pt15 ang -33)
pt17 pt15
pt18 (polar pt12 ang1 3)
pt19 pt17
pt20 pt12
pt21 (polar pt18 ang 3)
pt22 pt20
pt23 pt11
pt24 (polar pt21 ang 3)
pt25 pt11
pt26 pt10
)
(commandpt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10
pt11 pt12 pt13 pt14 pt15 pt16 pt17 pt18
pt19 pt20 pt21 pt22 pt23 pt24 pt25 pt26)
);end of progn
(progn
(setq pt2 pt-end
pt3 pt1
pt4 pt11
pt5 pt24
pt6 pt25
pt7 (polar pt2 ang1 3)
)
(setq key nil)
(command pt2 pt3 pt4 pt5 pt6 pt7 "")
))
) ;end of while
(setq ec2 (entlast))
(command "change" ec2 "" "p" "c" 1 "")
(setvar "osmode" 255)
(command "undo" "end")
(princ "\n感谢你使用立面绘制程序,有问题及时与燕川布衣联系.\nQQ:112100528")
(princ) ;静默退出
)
PL线有许多重合线,trim时肯定会出错的.有个简单办法就是程序最后加上explode,把PL线炸开. 回复 ljpnb 的帖子
炸开后删除困难呀！ GBHSU建议那中间的那直线是整的，只画那斜的那9根线 本帖最后由 zhynt 于 2011-7-23 11:06 编辑
这个怎么样？
(defun zx (pt ang / pt1 pt2 pt3 pt4 sen)
(setq pt1 pt
pt2 (polar pt1 (+ ang (* 0.25 pi)) (* (sqrt 2) 3))
pt3 (polar pt2 (+ ang (* 0.75 pi)) (* (sqrt 2) 3))
pt4 (polar pt3 (+ ang (* 0.25 pi)) (* (sqrt 2) 3))
)
(command "PLINE" pt1 pt2 pt3 pt4 "")
(setq sen (entlast))
(command "change" sen "" "p" "c" 1 "")
(command "copy" sen "" pt1 (polar pt1 ang 3))
(command "copy" sen "" pt1 (polar pt1 ang 6))
)
(defun c:jlb ( )
(command "undo" "group")
(setvar "osmode" 255)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\n输入九厘板第一点："))
(setq p2 (getpoint p1 "\n输入九厘板下一点："))
(setvar "osmode" 0)
(command "line" p1 p2 "")
(setq ang (angle p1 p2))
(setq ang1 (+ ang (* pi 0.5)))
(setq ec (entlast))
(command "change" ec "" "p" "c" 2 "")
(command "line" (polar p1 ang1 9) (polar p2 ang1 9) "")
(setq ec1 (entlast))
(command "change" ec1 "" "p" "c" 2 "")
(command "line" (polar p1 ang1 3) (polar p2 ang1 3) "")
(setq ec3 (entlast))
(command "change" ec3 "" "p" "c" 1 "")
(command "line" (polar p1 ang1 6) (polar p2 ang1 6) "")
(setq ec3 (entlast))
(command "change" ec3 "" "p" "c" 1 "")
(setq dist (distance p1 p2)
ang (angle p1 p2)
)
(if (and (<= dist 39) (> dist 9))
(zx (polar p1 ang (/ (- dist 9) 2)) ang)
(progn (setq n (fix (/ dist 39)))
(repeat n (zx (polar p1 ang (+ (* (1- n) 9)(* n 30))) ang) (setq n (1- n)))
)
)
(setvar "osmode" 255)
(command "undo" "end")
(princ
"\n本程序改编于燕川布衣,有问题及时与他或她联系.\nQQ:112100528"
)
(princ) ;静默退出
)
回复 zhynt 的帖子
很好。。。。
版权公开，大家随便改，随便use! 效果：
本帖最后由 qcw911 于 2011-7-23 16:31 编辑
回复 zhynt 的帖子
能变更成输入命令后画好多个吗？
像院长那样
(defun zx (pt ang / pt1 pt2 pt3 pt4 sen)
(setq pt1 pt
pt2 (polar pt1 (+ ang (* 0.25 pi)) (* (sqrt 2) 3))
pt3 (polar pt2 (+ ang (* 0.75 pi)) (* (sqrt 2) 3))
pt4 (polar pt3 (+ ang (* 0.25 pi)) (* (sqrt 2) 3))
)
(command "PLINE" pt1 pt2 pt3 pt4 "")
(setq sen (entlast))
(command "change" sen "" "p" "c" 1 "")
(command "copy" sen "" pt1 (polar pt1 ang 3))
(command "copy" sen "" pt1 (polar pt1 ang 6))
)
(defun c:jlb ()
(command "undo" "group")
(setvar "osmode" 255)
(setvar "cmdecho" 0)
(while (setq p1 (getpoint "\n输入九厘板第一点："))
(setq p2 (getpoint p1 "\n输入九厘板下一点："))
(setvar "osmode" 0)
(command "line" p1 p2 "")
(setq ang (angle p1 p2))
(setq ang1 (+ ang (* pi 0.5)))
(setq ec (entlast))
(command "change" ec "" "p" "c" 2 "")
(command "line" (polar p1 ang1 9) (polar p2 ang1 9) "")
(setq ec1 (entlast))
(command "change" ec1 "" "p" "c" 2 "")
(command "line" (polar p1 ang1 3) (polar p2 ang1 3) "")
(setq ec3 (entlast))
(command "change" ec3 "" "p" "c" 1 "")
(command "line" (polar p1 ang1 6) (polar p2 ang1 6) "")
(setq ec3 (entlast))
(command "change" ec3 "" "p" "c" 1 "")
(setq dist (distance p1 p2)
ang(angle p1 p2)
)
(if (and (<= dist 39) (> dist 9))
(zx (polar p1 ang (/ (- dist 9) 2)) ang)
(progn (setq n (fix (/ dist 39)))
(repeat n
(zx (polar p1 ang (+ (* (1- n) 9) (* n 30))) ang)
(setq n (1- n))
)
)
)
(setvar "osmode" 255)
(command "undo" "end")
)
(princ
"\n本程序改编于燕川布衣,有问题及时与他或她联系.\nQQ:112100528"
)
(princ) ;静默退出
)
页:
[1]