自动画任意角度，比例的填充。代码基本完成，求修改完善！

浪子_无限

本人上次想求一个这样的功能，暂时没有好的方法。后来借鉴了论坛中其它帖子的经验，自己修改组合拼凑了一段代码，但是总有点问题。


;;;任意角度绘制矩形，已知方向、边长,然后填充图案
;;;命令名：3p-juxing1
;;;日 期：Zo Roo 于 2012-10-27
(defun C:tt(/ PT1 PT2 PT3 PT4 H ANG ANG2 TEST TMP)
(prompt "BY Zo Roo 武赤公路 浪子_无限 修改 2015-04-11")
    (while (setq PT1 (getpoint "\n第一点:"))
(if (setq PT2 (getpoint PT1 " \n 指定方向:"))
     (progn
   (setq ANG (angle PT1 PT2)
         ANG0 (angle PT1 PT2)
         ANG (+ ANG (* 0.5 pi))
        
)
   (princ " \n 指定矩形所在的方向:")
;;;;;;;
(setq PT3 (getpoint " \n 指定矩形所在的方向:"))
(setq pt01 pt1)

;;计算出虚拟点位
(setq PT4 (polar PT3 ANG 100)
      PT4 (inters PT1 PT2 PT3 PT4 NIL)
       )
;;;;;;
(setq H  (distance PT4 PT3)
      ANG2 (angle PT3 PT4)
       )      
;;
(setq dist0 (distance PT1 PT2)
      PT5 (getpoint PT2 "填充厚度")
      dist2 (distance PT2 PT5)

      );修改部分-矩形宽
(setq PT02 (polar PT01 ANG0 dist0))
(setq PT03 (polar PT02 (- ANG2  pi) dist2));修改部分-对角点
(setq PT04 (polar PT01 (- ANG2  pi) dist2));修改部分
(command "_.pline"   "non"
       PT01   "non"   PT02
       "non"   PT03   "non"
       PT04   "c"
(setq e (entlast)
ANG (* ang (/ 180 pi))
)
;(command "hatch" "o" "s" pt1 "n" "p" "bwm" dist2 ang e "")   ;为何选用此句实现填充会出错？
(command "hatch" "o" "d" "c" "n" "p" "bwm" dist2 ang e "")    ;为何此句中填充原点设置不起作用？而且必须响应一次键盘或鼠标动作，图案才出现？
      )
(prompt "绘制完毕！！")  ;整体命令是连续执行的，怎样改成只执行一次？
     
     )
)
    )

    (princ)
) ;_ 结束defun

哪位高手帮我看下，应该修改什么地方呢？

琴剑江山_10184

(while (setq PT1 (getpoint "\n第一点:"))
把while 去掉，
后面也要去掉一个括号，，这样就只执行一次了，，

浪子_无限

琴剑江山_10184 发表于 2015-4-11 12:01
(while (setq PT1 (getpoint "\n第一点:"))
把while 去掉，
后面也要去掉一个括号，，这样就只执行一次了 ...

多谢多谢。

rocking2008

东西不错，楼主也历害