[编程申请]：以该端点为起点，画一条同斜率的、长度为1000的、颜色为4＃色的line线

lengliqun · 发表于 2008-1-27 22:09:26

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

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

×

图中有一条线LINE，在靠近端点处点击一下，则以该端点为起点，画一条同斜率的、长度为1000的、颜色为4＃色的line线。

再次上传附件。
不好意思，若还是不能下载，请到如下邮箱下载。
xdcadnet@163.com的密码是abc123
*-*4 *-*4

zxq0220 · 发表于 2008-1-28 08:12:41

看不到图，根据文字叙述写了个程序，看对不对。
[php]
;画选定线相同斜率长1000，4#色的线段。晓东 zxq0220 2008.1.28
(DEFUN C:TT ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(IF (AND (SETQ PT (GETPOINT "\nSelect a Line 选择一直线 :"))
      (SETQ PT1 (OSMODE PT "END"))
   (SETQ S1 (SSGET "C" PT1 PT1))
   (SETQ ENT (ENTGET(SSNAME S1 0)))
   (= (CDR (ASSOC 0 ENT)) "LINE")
   ) (PROGN
  (SETQ P1 (CDR (ASSOC 10 ENT))
      P2 (CDR (ASSOC 11 ENT)))
  (IF (> (DISTANCE P1 PT1) 0.0) (SETQ PTM P1 P1 P2 P2 PTM))
  (SETQ PT2 (POLAR P1 (ANGLE P1 P2) 1000))
  (COMMAND "LINE" P1 PT2 "" "CHPROP" "L" "C" "4" "")
))
(PRINC)
)
[/php]

lengliqun · 发表于 2008-1-28 09:06:17

若不能下载附件，请到如下邮箱下载。
xdcadnet@163.com的密码是abc123

运行二楼的程序，提示：
命令: tt
Select a Line 选择一直线 :; 错误: no function definition: OSMODE

zxq0220 · 发表于 2008-1-28 15:30:32

改了改
[php]
;画选定线相同斜率长1000，4#色的线段。晓东 zxq0220 2008.1.28
(DEFUN C:TT ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(IF (AND (SETQ PT (GETPOINT "\nSelect a Line 选择一直线 :"))
      (SETQ PT1 (OSNAP PT "END"))
   (SETQ S1 (SSGET "C" PT1 PT1))
   (SETQ ENT (ENTGET(SSNAME S1 0)))
   (= (CDR (ASSOC 0 ENT)) "LINE")
   ) (PROGN
  (SETQ P1 (CDR (ASSOC 10 ENT))
      P2 (CDR (ASSOC 11 ENT)))
  (IF (> (DISTANCE P1 PT1) 0.0) (SETQ PTM P1 P1 P2 P2 PTM))
  (SETQ PT2 (POLAR P1 (ANGLE P1 P2) 1000))
  (SETVAR "OSMODE" 0)
  (COMMAND "LINE" P1 PT2 "" "CHPROP" "L" "" "C" "4" "")
  (SETVAR "OSMODE" OLDOS)
))
(SETVAR "CMDECHO" 1)
(PRINC)
)
[/php]

lengliqun · 发表于 2008-1-28 17:18:59

测试了一下，还有两个小问题：
1，对不与其它line相交的单条线测试正常，对于“田”“口”字形图测试时，有时画不出线来，或画出来的线与原来的线垂直。
2，可能由于我的表达不清楚，可否将画出来的线与原来的线重合，而不跑到原来的线外侧。

zxq0220 · 发表于 2008-1-28 19:30:27

再试试
[php]
;画选定线相同斜率长1000，4#色的线段。晓东 zxq0220 2008.1.28
(DEFUN C:TT ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(IF (AND (SETQ S1 (ENTSEL "\nSelect a Line 选择一直线 :"))
      (SETQ ENT (ENTGET(CAR S1)))
      (SETQ PT1 (OSNAP (CADR S1) "END"))
   (= (CDR (ASSOC 0 ENT)) "LINE")
   ) (PROGN
  (SETQ P1 (CDR (ASSOC 10 ENT))
      P2 (CDR (ASSOC 11 ENT)))
  (IF (> (DISTANCE P1 PT1) 0.0) (SETQ PTM P1 P1 P2 P2 PTM))
  (SETQ PT2 (POLAR P1 (ANGLE P1 P2) 1000))
  (SETVAR "OSMODE" 0)
  (COMMAND "LINE" P1 PT2 "" "CHPROP" "L" "" "C" "4" "")
  (SETVAR "OSMODE" OLDOS)
))
(SETVAR "CMDECHO" 1)
(PRINC)
)
[/php]

lengliqun · 发表于 2008-1-28 22:52:12

CAD2004测试达到要求，非常感谢。
谢谢。

sdtgq · 发表于 2008-1-31 14:03:39

学习一下^_^

chxl5878 · 发表于 2014-1-20 16:33:44

顶顶顶顶顶顶顶顶

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

[编程申请]：以该端点为起点，画一条同斜率的、长度为1000的、颜色为4＃色的line线

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

相关帖子