画矩形后直接连带着在矩形内画两条斜直线

yyz123121 · 发表于 2020-11-13 15:49

在画节点图的时候经常需要画木龙骨，虽然做了木龙骨的动态块，可以每次还是要复制、拉伸，想要直接输入命令后选两个对角点，然后就出来矩形和里边的两条斜线。
这个代码需要输入两次数值，不够完美。
(defun c:rrx(/ pa pb pc pd ww hh mp1 mp2 mp3 mp4)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
;以下 pa、ww、hh 值须由使用者输入
(setq pa (getpoint "Enter Left/Low Point:"))
(setq ww (getdist pa "\nWidth:"))
(setq hh (getdist pa "\nHeight:"))
;以下pb、pc、pd值须由程序依据pa、ww、hh求出
(setq pb (polar pa 0 ww))
(setq pc (polar pb (/ pi 2) hh))
(setq pd (polar pc pi ww))
;以下依据 pa、pb、pc、pd 点画矩形
(command "pline" pa pb pc pd "c")
(command "line" pa pc "")
(command "line" pb pd "")
(prin1)
)

start4444 · 发表于 2020-11-14 18:10

yyz123121 发表于 2020-11-14 16:16
请问下，我想设置矩形里边的两条斜线的颜色和线型，比如颜色设置成8，如何设置呢

在前面加上颜色命令即可，线型一个道理
(command "RECTANGLE" "non" (setq p1 (getpoint "\n点1:")) "non" (setq p2 (getcorner p1 "\n点2:")) "cecolor" "8" "line" "non" p1 "non" p2 "" "line" "non" (list (car p1) (cadr p2)) "non" (list (car p2) (cadr p1)) "")

start4444 · 发表于 2020-11-13 17:54

(command "RECTANGLE" "non" (setq p1 (getpoint "\n点1:")) "non" (setq p2 (getcorner p1 "\n点2:")) "line" "non" p1 "non" p2 "" "line" "non" (list (car p1) (cadr p2)) "non" (list (car p2) (cadr p1)) "")

yyz123121 · 发表于 2020-11-14 15:13

start4444 发表于 2020-11-13 17:54
(command "RECTANGLE" "non" (setq p1 (getpoint "\n点1:")) "non" (setq p2 (getcorner p1 "\n点2:")) "li ...

谢谢大神！！！

yyz123121 · 发表于 2020-11-14 16:16

start4444 发表于 2020-11-13 17:54
(command "RECTANGLE" "non" (setq p1 (getpoint "\n点1:")) "non" (setq p2 (getcorner p1 "\n点2:")) "li ...

请问下，我想设置矩形里边的两条斜线的颜色和线型，比如颜色设置成8，如何设置呢

yyz123121 · 发表于 2020-11-15 00:10

谢谢大神！木龙骨的动态块可以删了

xotoo · 发表于 2021-9-8 12:07

start4444 发表于 2020-11-13 17:54
(command "RECTANGLE" "non" (setq p1 (getpoint "\n点1:")) "non" (setq p2 (getcorner p1 "\n点2:")) "li ...

能不能麻烦把这个编译成一个完整的可运行LSP文件?

atone · 发表于 2024-2-13 10:42

没有后续啦呀，还想看大神出手

lixiangyu1025 · 发表于 2024-3-25 15:06

(defun c:rf4 ()
  (command "undo" "begin")
  (setvar "cmdecho" 0)
  (setq cly (getvar "clayer"))
  (setvar "clayer" "RF_S")
  (setq p1 (getpoint "\n起点:"))
  (setq p2 (getpoint "\n终点:"))
  (setq p3 (list (car p1) (cadr p2)))
  (setq p4 (list (car p2) (cadr p1)))
  (command "line" p1 p2 "")
  (command "line" p3 p4 "")
  (command "RECTANGLE" p1 p2)
  (setvar "clayer" cly)
  (command "undo" "end")
  (prin1)
)
;;;;;我自己写的，画人防门示意用的

账号		自动登录	找回密码
密码			注册

[提问] 画矩形后直接连带着在矩形内画两条斜直线

本帖子中包含更多资源

评分

本帖子中包含更多资源