[编程申请]：求lsp程序，将水平标注的尺寸放到“水平标注”图层里，将垂直标注的尺寸

lengliqun · 发表于 2007-12-13 16:32:28

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

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

×

求lsp程序，图中有若干尺寸标注，框选这些标注，将水平标注的尺寸放到“水平标注”图层里，将垂直标注的尺寸放到“垂直标注”图层里，斜向标注的尺寸不变，谢谢。

zxq0220 · 发表于 2007-12-15 18:48:32

[php]
;将尺寸标注放入相应图层晓东 zxq0220 2007.12.15
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq cl (getvar "CLAYER"))
(if (setq ss (ssget "X" '((0 . "DIMENSION") (50 . 0.0)))) (progn
  (command "LAYER" "M" "水平标注" "")
  (command "CHPROP" ss "" "LA" "水平标注" "")
))
(if (setq ss (ssget "X" (list '(0 . "DIMENSION") (cons 50 (/ pi 2))))) (progn
  (command "LAYER" "M" "垂直标注" "")
  (command "CHPROP" ss "" "LA" "垂直标注" "")
))
(setvar "CLAYER" cl)
(setvar "CMDECHO" 1)
(princ)
)
[/php]

lengliqun · 发表于 2007-12-16 16:01:55

二楼程序经CAD2004测试可用，zxq0220 长老。

cy956 · 发表于 2007-12-17 17:33:13

应该不完美，针对dimalign类型的会出错

lengliqun · 发表于 2007-12-17 18:08:21

再测试，cad2004中，有部分尺寸无效，请下载附件测试。

zxq0220 · 发表于 2007-12-21 19:02:53

无法下载。

lengliqun · 发表于 2007-12-23 09:58:03

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

zxq0220 · 发表于 2007-12-23 11:33:19

[php]
;将尺寸标注放入相应图层晓东 zxq0220 2007.12.23
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq cl (getvar "CLAYER"))
(if (setq ss (ssget "X" (list (cons 0  "DIMENSION")))) (progn
  (setq i -1 ld (ssadd) vd (ssadd))
  (repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
         ang (rem (cdr (assoc 50 (entget en)))pi))
; (princ ang) (princ " ")
(if (equal ang 0.0 1e-3) (setq ld (ssadd en ld)))
(if (equal ang (/ pi 2) 1e-3) (setq vd (ssadd en vd)))
  )
  (if (> (sslength ld) 1) (progn
(command "LAYER" "M" "水平标注" "")
(command "CHPROP" ld "" "LA" "水平标注" "")
  ))
  (if (> (sslength vd) 1) (progn
(command "LAYER" "M" "垂直标注" "")
(command "CHPROP" vd "" "LA" "垂直标注" "")
  ))
))
(setvar "CLAYER" cl)
(setvar "CMDECHO" 1)
(princ)
)
[/php]

lengliqun · 发表于 2007-12-23 13:01:06

用CAD2004换个dwg文件测试，还是有问题，测试文件放在
xdcadnet@163.com 密码acb123
还请修正，呵呵。

xqz301130 · 发表于 2007-12-23 20:47:52

这个程序有什么用啊？不懂，我是初学者

zxq0220 · 发表于 2007-12-23 23:02:54

[php]
;将尺寸标注放入相应图层晓东 zxq0220 2007.12.23
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq cl (getvar "CLAYER"))
(if (setq ss (ssget "X" (list (cons 0 "DIMENSION")))) (progn
  (setq i -1 ld (ssadd) vd (ssadd))
  (repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
      ent (entget en))
(if (or (= (setq ty (cdr (assoc 70 ent))) 33) (= ty 161))
(setq ang (angle (cdr (assoc 13 ent)) (cdr (assoc 14 ent))))
(setq ang (cdr (assoc 50 ent)))
)
(setq ang (rem ang pi))
; (princ ang) (princ " ")
(if (equal ang 0.0 1e-3) (setq ld (ssadd en ld)))
(if (or (equal ang (/ pi 2) 1e-3) (equal ang (/ pi -2) 1e-3)) (setq vd (ssadd en vd)))
  )
  (if (> (sslength ld) 1) (progn
(command "LAYER" "M" "水平标注" "")
(command "CHPROP" ld "" "LA" "水平标注" "")
  ))
  (if (> (sslength vd) 1) (progn
(command "LAYER" "M" "垂直标注" "")
(command "CHPROP" vd "" "LA" "垂直标注" "")
  ))
))
(setvar "CLAYER" cl)
(setvar "CMDECHO" 1)
(princ)
)
[/php]

lengliqun · 发表于 2007-12-24 00:56:35

呵呵，可以了，感谢zxq0220 大侠。

lengliqun · 发表于 2007-12-24 01:06:30

呵呵，可以了，感谢zxq0220 大侠。
这个程序有什么用呢？将水平标注与垂直标注提取出来，通过修改尺寸的坐标将其标注自动取整,而斜向标注的尺寸，即使将其坐标取整，标出来的数值还是零丁。

gogo9567 · 发表于 2008-1-22 10:55:53

我现在爱心币不够,不能下载.呢给个地址吗?我直接下载.

zxq0220 · 发表于 2008-1-23 13:36:29

程序可以直接拷贝到剪切板中，不要币。

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

[编程申请]：求lsp程序，将水平标注的尺寸放到“水平标注”图层里，将垂直标注的尺寸

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

相关帖子