一个非常好的程序，但有时候会出错，龙哥，再帮忙来看看

userzhl · 发表于 2006-1-8 17:00:00

本帖最后由作者于 2006-1-15 10:16:48 编辑

;★长度型标注断开
(defun zm (et x /) (cdr (assoc x (entget et))))
(defun pzm (nwzm y obj /)
(entmod(subst(cons y nwzm)(assoc y (entget obj))
         (entget obj)))
)
(defun objnm (ent)
(vla-get-objectname (vlax-ename->vla-object ent))
)
(defun maxlst (pts / js i x tt jl ds)
(setq    js 0 i 0)
(repeat (length pts)
    (setq tt (nth i pts))
    (mapcar '(lambda (x)
           (if (> (setq ds (distance tt x)) js)
         (setq js ds
               jl (list x tt)))
         )pts)
    (setq i (1+ i)))jl
)
(defun c:db (/ ENT ENT1 GETPT JPT PT1 PT2 XL)
(vl-load-com)(vl-cmdf "undo" "be")
(if (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
    (progn
      (redraw ent 3)
      (setq getpt (getpoint "\n点取断开点:"))
      (redraw ent 4)
      (vl-cmdf ".copy" ent "" '(0 0) "@")
      (setq ent1 (entlast))
      (setq pt1    (zm ent 13)pt2(zm ent 14))
      (if (= (objnm ent) "AcDbAlignedDimension")
    (vl-cmdf ".xline" pt1 pt2 "")
    (vl-cmdf ".xline" "a" (angtos (zm ent 50) 0 4) pt1 "")
      )
      (setq xl(entlast))
      (pzm(setq jpt (vlax-curve-getClosestPointTo xl getpt))13 ent)
      (pzm jpt 14 ent1)(vl-cmdf ".erase" xl ""))
)(vl-cmdf "undo" "e")(princ)
)

sihan · 发表于 2006-1-9 20:14:00

程序的功能是什么?

userzhl · 发表于 2006-1-11 13:40:00

楼上，此功能是：双向偏移！

ljpnb · 发表于 2006-1-11 15:25:00

(defun mk_list (/ layer_name)
(setq layer_list (list))
(setq layer_name (cdr (assoc 2 (tblnext "layer" t))))
(while layer_name
    (if (= layer_name of_lay)
      nil                                          ;_这儿的nil多了
      (setq layer_list (append
    layer_list
    (list layer_name)
         )
      )
    )

我试了一下，主程序部份没什么问题，问题应该出在调用对话框部份，楼主的编写的想法不错，应该是个实用的程序

tc405003 · 发表于 2006-1-11 22:41:00

将文件贴完才可以看哪里有问题,

现在看的话

(defun mk_list (/ layer_name)
(setq layer_list (list))
(setq layer_name (cdr (assoc 2 (tblnext "layer" t))))
(while layer_name
    (if (= layer_name of_lay)
      nil                                          ;_这儿的nil应该写在(= layer_name of_lay nil)中

      (setq layer_list (append
    layer_list
    (list layer_name)
         )
      )
    )

userzhl · 发表于 2006-1-12 09:46:00

4楼，;_nil不是多余的，我试过了，问题不是出在这里。

userzhl · 发表于 2006-1-12 23:04:00

5楼，像你说的这样，也不行

userzhl · 发表于 2006-1-13 10:00:00

补充上传对话框DCL文件

userzhl · 发表于 2006-1-13 10:28:00

本帖最后由作者于 2006-1-13 20:36:06 编辑

;★长度型标注断开
(defun zm (et x /) (cdr (assoc x (entget et))))
(defun pzm (nwzm y obj /)
(entmod(subst(cons y nwzm)(assoc y (entget obj))
         (entget obj)))
)
(defun objnm (ent)
(vla-get-objectname (vlax-ename->vla-object ent))
)
(defun maxlst (pts / js i x tt jl ds)
(setq    js 0 i 0)
(repeat (length pts)
    (setq tt (nth i pts))
    (mapcar '(lambda (x)
           (if (> (setq ds (distance tt x)) js)
         (setq js ds
               jl (list x tt)))
         )pts)
    (setq i (1+ i)))jl
)
(defun c:db (/ ENT ENT1 GETPT JPT PT1 PT2 XL)
(vl-load-com)(vl-cmdf "undo" "be")
(if (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
    (progn
      (redraw ent 3)
      (setq getpt (getpoint "\n点取断开点:"))
      (redraw ent 4)
      (vl-cmdf ".copy" ent "" '(0 0) "@")
      (setq ent1 (entlast))
      (setq pt1    (zm ent 13)pt2(zm ent 14))
      (if (= (objnm ent) "AcDbAlignedDimension")
    (vl-cmdf ".xline" pt1 pt2 "")
    (vl-cmdf ".xline" "a" (angtos (zm ent 50) 0 4) pt1 "")
      )
      (setq xl(entlast))
      (pzm(setq jpt (vlax-curve-getClosestPointTo xl getpt))13 ent)
      (pzm jpt 14 ent1)(vl-cmdf ".erase" xl ""))
)(vl-cmdf "undo" "e")(princ)
)

ljpnb · 发表于 2006-1-13 11:29:00

试了一下，没什么问题啊，只是当偏移距离过大时，对圆或圆弧偏移就会出现1楼的错误，加个判断可能会更完美些

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