[分享]尺寸合并，分解

lzy9788 · 发表于 2004-5-10 14:40:00

提供一个尺寸合并、分解的源程序，请各位指点意见……
在使用中会出现问题吗?
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;尺寸合并 2004年4月;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ccb ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(princ "\n尺寸合并>.请选择要合并的尺寸:")
(setq ss1 (ssget ":s" '((0 . "DIMENSION"))))
(setq nam1 (ssname ss1 0)
   ent1 (entget nam1)
   pdim1_13 (cdr (assoc 13 ent1))
   pdim1_14 (cdr (assoc 14 ent1)))
(setq ss2 (ssget ":s" '((0 . "DIMENSION"))))
(setq nam2 (ssname ss2 0)
   ent2 (entget nam2)
   pdim2_13 (cdr (assoc 13 ent2))
   pdim2_14 (cdr (assoc 14 ent2)))
(vl-load-com)
(setq bb (list pdim1_13 pdim1_14 pdim2_13 pdim2_14))
(setq bb1
   (vl-sort bb
   (function (lambda (e1 e2)
   (>.\n请选择要分解的尺寸:")
(setq ss1 (ssget ":s" '((0 . "DIMENSION"))))
(setq point (getpoint "\n请点取分解点位置:"))
(setq nam1 (ssname ss1 0)
   ent1 (entget nam1)
   pdim1_13 (cdr (assoc 13 ent1))
   pdim1_14 (cdr (assoc 14 ent1)))
(command "copy" ss1 "")
(setq ss2 (entlast))
(setq ent2 (entget ss2)
   pdim2_13 (cdr (assoc 13 ent2))
   pdim2_14 (cdr (assoc 14 ent2)))
(setq bb (list pdim1_13 pdim1_14))
(setq bb1
   (vl-sort bb
   (function (lambda (e1 e2)
   ( (angle point (nth 0 bbb)) (angle (nth 1 bbb) (nth 0 bbb)))
   (setq cankaodian (polar point (+ (angle (nth 0 bbb) (nth 1 bbb)) (* pi 1.5)) 90000)))
   ((" point "@0,0[/hide]

wyj_007 · 发表于 2004-5-20 14:44:00

这个功能在天正里的尺寸工具栏里有了。

无痕 · 发表于 2004-5-20 20:09:00

ｃｃｂ好些，但也有不听话的时候
ｃｃｆ错误多些，经常有
错误: DXF 组不正确: (14)
错误: DXF 组不正确: (1３)
非ｗｃｓ下，ｃｃｆ几乎不能用，ｃｃｄ有的合并后没有删除原标注

ljcgq · 发表于 2004-5-20 22:05:00

;=====================================
; 水平尺寸线分割标注
;=====================================
(defun c:fg( /)
   (print "请选择要分割的尺寸线:")
   (setq ss (ssget ]    (command "point"    (cdr (assoc 13 (entget (ssname    ss 0 ))))    )
   (setq ss1 (ssadd    (entlast) ss1    ))
   (command "point"    (cdr (assoc 14 (entget (ssname    ss 0 ))))    )
   (setq ss1 (ssadd    (entlast) ss1))
   (command    "point"    (getpoint "请选择分割点:"    )    )
   (setq ss1    (ssadd    (entlast) ss1) )
   (setq os (getvar "osmode") )
   (command "qdim" ss1    ""    (cdr (assoc 10 (entget (ssname    ss 0 )))) )
   (command "erase" ss1 "" ) (command "erase" ss "" )
   (setvar "osmode" os)
)

ljcgq · 发表于 2004-5-20 22:09:00

以上程序需要修改，麻烦帮我看一下。

无痕 · 发表于 2004-5-21 00:59:00

ljcgq[/url]，照片里面是你还是你老婆孩子？

无痕 · 发表于 2004-5-21 02:49:00

不过，对倾斜的标注，这个算法还是有问题的
(defun c:fg( /)
   (print "请选择要分割的尺寸线:")
   (setq ss (ssget ":s" '(( 0 . "DIMENSION" )) )
   ss1 (ssadd));!!!!!
   (command "point"    (cdr (assoc 13 (entget (ssname    ss 0 ))))    )
   (setq ss1 (ssadd    (entlast) ss1    ))
   (command "point"    (cdr (assoc 14 (entget (ssname    ss 0 ))))    )
   (setq ss1 (ssadd    (entlast) ss1))
   (command    "point"    (getpoint "请选择分割点:"    )    )
   (setq ss1    (ssadd    (entlast) ss1) )
   (setq os (getvar "osmode") )
   (command "qdim" ss1    ""    (cdr (assoc 10 (entget (ssname    ss 0 )))) )
   (command "erase" ss1 "" ) (command "erase" ss "" )
   (setvar "osmode" os)
)