如何定义指定尺寸的矩形？

zilong136 · 发表于 2024-3-5 16:48:54

本帖最后由 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)

飞雪神光 · 发表于 2024-3-6 10:57:21

zilong136 发表于 2024-3-6 10:51
能否跟我第二个代码一样，带记忆功能？

忘记了弄全局变量了把这三个删掉就可以记忆了

zilong136 · 发表于 2024-3-6 11:23:26

飞雪神光发表于 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)
)
  )
)

飞雪神光 · 发表于 2024-3-5 19:14:09

(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)
)

zilong136 · 发表于 2024-3-5 20:28:23

飞雪神光发表于 2024-3-5 19:14

可以，怎么写一个函数，就是可以把矩形的几个特征点作为基点可以切换，基点为左上、上中、上右、下左、下中、下右六个基点？

飞雪神光 · 发表于 2024-3-5 22:16:56

可以弄个关键词来进行基点的切换可以配合cond用但是这样代码就复杂了简单的就是计算好那六个点画完了用 move移动

zilong136 · 发表于 2024-3-5 22:45:55

飞雪神光发表于 2024-3-5 22:16
可以弄个关键词来进行基点的切换可以配合cond用但是这样代码就复杂了简单的就是计算好那六个点画完了用 ...

帮我把下面那串代码改下

yefei812678 · 发表于 2024-3-6 08:17:42

谢谢分享谢谢分享谢谢分享

飞雪神光 · 发表于 2024-3-6 08:57:23

ht1480 · 发表于 2024-3-6 09:08:18

”RECTANG““X长度”“,”"Y长度"
RECTANG
指定第一个角点或 [倒角(C)/标高(E)/圆角(F)/厚度(T)/宽度(W)]:
指定另一个角点或 [面积(A)/尺寸(D)/旋转(R)]: @-5,6

zilong136 · 发表于 2024-3-6 10:51:58

飞雪神光发表于 2024-3-6 08:57

能否跟我第二个代码一样，带记忆功能？

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

如何定义指定尺寸的矩形？

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源