[讨论]：[0519]如何将此倾斜矩形绘制程序简化?

tctabc · 发表于 2006-5-19 18:23:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

小弟练习将绘制矩形可以使用倾斜角度方式绘出,
但个人认为程序应该可以简化,
因此放上来请各位高手指点
烦请各位可以提供宝贵的意见~
谢谢~

(defun c:test ()
(setq pt1 (getpoint "\n 长度方向基点:") )
(setq pt2 (getpoint pt1 "\n 长度方向终点:") )
(setq pt3 (getpoint pt2 "\n 宽度方向:") )
(setq ofs (getdist pt2 "\n 宽度距离:") )
(command "_.line" pt1 pt2 "")
(setq en1 (entlast))
(setq ob1 (entget en1))
(command "_.offset" ofs en1 pt3 "" )
(setq en2 (entlast))
(setq ob2 (entget en2))
(command "_.line" (cdr (assoc 10 ob1))  (cdr (assoc 10 ob2) ) "")
(setq en3 (entlast))
(command "_.line" (cdr (assoc 11 ob1))  (cdr (assoc 11 ob2) ) "")
(setq en4 (entlast))

(setq ss (ssadd))
(ssadd en1 ss)
(ssadd en2 ss)
(ssadd en3 ss)
(ssadd en4 ss)
(setq i 0)

  (while (< i (sslength ss))
(setq ssa-ent (ssname ss i))
(setq ent-p (cdr (assoc 0 (entget ssa-ent))))
(if (not (null ent-p)) ;判断原图元是否已串入多义线
   (if (or (= ent-p "LWPOLYLINE") (= ent-p "POLYLINE"))
;判断原图元属性
(command "pedit" ssa-ent "j" ss "" "")
(command "pedit" ssa-ent "y" "j" ss "" "")
   )
)
(setq i (1+ i))
  )
)

王咣生 · 发表于 2006-5-20 07:07:24

[PHP]
(defun c:test ()
  (setq pt (getpoint "\n选择基点:")
ang (getangle "\n旋转角度:")
wid (getdist "\n宽度:")
hid (getdist "\n高度:"))

  (command "ucs" "w" "ucs" "n" "z" (* (/ ang 3.1415926) 180.0))

  (command "rectang" pt (list (+ (car pt) wid) (+ (cadr pt) hid)))

  (command "ucs" "w")

  (princ)
)
[/PHP]

雨箭风刀 · 发表于 2006-5-20 10:41:20

(command "ucs" "w" "ucs" "n" "z" (* (/ ang 3.1415926) 180.0))
改(command "ucs" "n" "z" (* (/ ang 3.1415926) 180.0))

(command "ucs" "w")
改 (command "ucs" "P")

真龙天子 · 发表于 2006-5-20 23:20:20

;;画斜矩形
(defun c:hxjx ()
  (CMDLA0)
(setvar "cmdecho" 0)
   (setq pa (getpoint "\n第一角点：")
         pb (getpoint "\n第二角点：")
         pc (getpoint "\n第三角点：")
         la (distance pa pb)
         lb (distance pb pc)
         lc (sqrt (+ (* la la) (* lb lb)))
         aa (angle pa pb)             ;计算与x轴的夹角aa
         ab (atan (/ lb la))
         ac (+ aa (/ pi 2))
         pc (Polar  Pa  (+ aa ab)  lc)
         pd (Polar  Pa ac lb)
   )
(setvar "osmode" 0)
   (command "pline" pa pb pc pd "c")
(setvar "osmode" 47)
  (CMDLA1)
)
               (prompt "<<画斜矩形>>启动命令:hxjx")
                  (princ)

qiaqiadeng · 发表于 2006-7-3 15:58:05

这样可能会舒服一点：
(defun c:jx ()
(CMDLA0)
(setvar "cmdecho" 0)
(setq pa (getpoint "\n第一角点：")
pb (getcorner pa "\n第二角点：")
pc (getpoint pa "\n第三角点：")
la (distance pa pb)
lb (distance pb pc)
lc (sqrt (+ (* la la) (* lb lb)))
aa (angle pa pb) ;计算与x轴的夹角aa
ab (atan (/ lb la))
ac (+ aa (/ pi 2))
pc (Polar Pa (+ aa ab) lc)
pd (Polar Pa ac lb)
)
(setvar "osmode" 0)
(command "pline" pa pb pc pd "c")
(setvar "osmode" 47)
(CMDLA1)
)
(prompt "<<画斜矩形>>启动命令:hxjx")
(princ)

xyp1964 · 发表于 2006-7-3 16:23:11

[FONT=courier new](defun c:test ()
(cmdla0)
(setq ang (UANGLE 1 "" "旋转角度<输入或鼠标直接量取>" ANG nil)
wid (UDIST 1 "" "宽度<输入或鼠标直接量取>" wid nil)
hid (UDIST 1 "" "高度<输入或鼠标直接量取>" hid nil)
os (getvar"osmode")
)
(while (setq pt (getpoint "\n选择基点<退出>: "))
(setvar"osmode"0)
(command "rectang" pt(list (+ (car pt) wid) (+ (cadr pt) hid)))
(if (/= ang 0)
(command "rotate" "l" "" pt (rad2ang ang))
)
(setvar"osmode"os)
)
(cmdla1)
)[/FONT]

真龙天子 · 发表于 2006-7-3 22:22:35

本人自编了一个，目的是在描地形图居民点时方便，不知是否适合楼主．
;;画斜矩形
(defun c:hxjx ()
(setvar "cmdecho" 0)
   (setq pa (getpoint "\n第一角点：")
         pb (getpoint "\n第二角点：")
         pc (getpoint "\n第三角点：")
         la (distance pa pb)
         lb (distance pb pc)
         lc (sqrt (+ (* la la) (* lb lb)))
         aa (angle pa pb)             ;计算与x轴的夹角aa
         ab (atan (/ lb la))
         ac (+ aa (/ pi 2))
         pc (Polar  Pa  (+ aa ab)  lc)
         pd (Polar  Pa ac lb)
   )
(setvar "osmode" 0)
   (command "pline" pa pb pc pd "c")
(setvar "osmode" 47)
)
               (prompt "<<画斜矩形>>启动命令:hxjx")
                  (princ)

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

[讨论]：[0519]如何将此倾斜矩形绘制程序简化?

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子