如何定义指定尺寸的矩形？
本帖最后由 zilong136 于 2024-3-6 23:30 编辑[*]如何优化下列代码，一步完成任意尺寸矩形的绘制？基点改为左上方，如图所示
[*]
[*](defun c:j()
[*](prompt "\n j:矩形")
[*](setq cmd (getvar "cmdecho"))
[*](setvar "cmdecho" 0)
[*](setq pa (getpoint "\n请指定基点:"))
[*](setq ww (getdist "\n宽度:"))
[*](setq hh (getdist "\n高度:"))
[*](setq pb (polar pa 0 ww))
[*](setq pc (polar pb (/ pi 2) hh))
[*](setq pd (polar pc pi ww))
[*](setq osm (getvar "osmode"))
[*](setvar "osmode" 0)
[*](command "_pline" pa pb pc pd "c")
[*](setvar "osmode" osm)
[*](setvar "cmdecho" cmd)
[*](princ)
[*])
2.怎么把下面基点改为下中、右下？
[*](defun c:x4 (/ h p p pt w)
[*] (prompt "\n X4:矩形--左下")
[*](if (and (or #BT-WWWWWWWWWWW (setq #BT-WWWWWWWWWWW 100))
[*] (or #BT-HHHHHHHHHH (setq #BT-HHHHHHHHHH 100))
[*] (or (and (setq w (getdist (strcat "\n宽度:<"(rtos #BT-WWWWWWWWWWW 2 2)">")))
[*] (setq #BT-WWWWWWWWWWW w)
[*] )
[*] #BT-WWWWWWWWWWW
[*] )
[*] (or (and (setq h (getdist (strcat "\n高度:<"(rtos #BT-HHHHHHHHHH 2 2)">")))
[*] (setq #BT-HHHHHHHHHH h)
[*] )
[*] #BT-HHHHHHHHHH
[*] )
[*] (setq p (getpoint "\n 基点:"))
[*] (setq pt (mapcar '+ p (list #BT-WWWWWWWWWWW #BT-HHHHHHHHHH 0)))
[*] )
[*] (progn
[*] (setvar "CMDECHO" 0)
[*] (command "RECTANG" "non" p "non" pt)
[*] (setvar "CMDECHO" 1)
[*] )
[*])
[*])
3.怎么把下面这些代码赋以记性功能？
[*];;;矩形--上中【X21】
[*](defun c:X21(/ pt ck c_k c k pt1 j)
[*](prompt "\n X21:矩形--上中")
[*](command "UNDO" "be")
[*](setq pt(getpoint "\n 指定基点(矩形上方中点)") ck(getstring "\n长,宽(英文下逗号)"))
[*](setq c_k (split ck ","))
[*](setq c(car c_k) k(cadr c_k))
[*](setq pt1(polar pt pi (/ (abs (atof c)) 2)))
[*](setq j(strcat "@" (rtos(abs(atof c))) ",-" (rtos(abs(atof k)))))
[*](command "RECTANG" pt1 j)
[*](command "UNDO" "e")
[*](princ)
[*])
[*](defun split (s p / r);分割字符串
[*](setq r (vlax-create-object "vbscript.regexp"))
[*](vlax-put-property r 'Global 1)
[*](vlax-put-property r 'Pattern p)
[*](read (strcat "(\"" (vlax-invoke r 'Replace s "\" \"") "\")"))
[*])
[*](princ)
zilong136 发表于 2024-3-6 10:51
能否跟我第二个代码一样，带记忆功能？
忘记了弄全局变量了 把这三个删掉就可以记忆了
飞雪神光 发表于 2024-3-5 19:14
怎么把下面基点改为下中、右下？
(defun c:x4 (/ h p p pt w)
(prompt "\n X4:矩形--左下")
(if (and (or #BT-WWWWWWWWWWW (setq #BT-WWWWWWWWWWW 100))
(or #BT-HHHHHHHHHH (setq #BT-HHHHHHHHHH 100))
(or (and (setq w (getdist (strcat "\n宽度:<"(rtos #BT-WWWWWWWWWWW 2 2)">")))
(setq #BT-WWWWWWWWWWW w)
)
#BT-WWWWWWWWWWW
)
(or (and (setq h (getdist (strcat "\n高度:<"(rtos #BT-HHHHHHHHHH 2 2)">")))
(setq #BT-HHHHHHHHHH h)
)
#BT-HHHHHHHHHH
)
(setq p (getpoint "\n 基点:"))
(setq pt (mapcar '+ p (list #BT-WWWWWWWWWWW #BT-HHHHHHHHHH 0)))
)
(progn
(setvar "CMDECHO" 0)
(command "RECTANG" "non" p "non" pt)
(setvar "CMDECHO" 1)
)
)
) (defun c:j()
(prompt "\n j:矩形")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq pa (getpoint "\n请指定基点:"))
(setq ww (getdist "\n宽度:"))
(setq hh (getdist "\n高度:"))
(setq pb (polar pa 0 ww))
(setq pc (polar pb (* pi 1.5) hh))
(setq pd (polar pc pi ww))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "_pline" pa pb pc pd "c")
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
) 飞雪神光 发表于 2024-3-5 19:14
可以，怎么写一个函数，就是可以把矩形的几个特征点作为基点可以切换，基点为左上、上中、上右、下左、下中、下右六个基点？ 可以弄个关键词来进行基点的切换 可以配合cond用 但是这样代码就复杂了 简单的就是计算好那六个点 画完了用 move移动 飞雪神光 发表于 2024-3-5 22:16
可以弄个关键词来进行基点的切换 可以配合cond用 但是这样代码就复杂了 简单的就是计算好那六个点 画完了用 ...
帮我把下面那串代码改下 谢谢分享谢谢分享谢谢分享 ”RECTANG““X长度”“,”"Y长度"
RECTANG
指定第一个角点或 [倒角(C)/标高(E)/圆角(F)/厚度(T)/宽度(W)]:
指定另一个角点或 [面积(A)/尺寸(D)/旋转(R)]: @-5,6
飞雪神光 发表于 2024-3-6 08:57
能否跟我第二个代码一样，带记忆功能？
页:
[1]
2