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

龙龙仔 · 发表于 2006-1-13 13:48

;;在XDCAD 狂刀 & LUCAS 给你提到问题点,但你好像没有看到....(非要写完整吗?)

userzhl · 发表于 2006-1-13 15:26

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

谢谢龙哥，再帮我看看下面这段程序好吗？有时时候也出问题的：

;★长度型标注断开
(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)
)

龙龙仔 · 发表于 2006-1-13 16:10

(defun 2OF_OPTION (/ DCL_ID LAYER_LIST NEXT_STEP)
(setq NEXT_STEP 2)
(while (>= NEXT_STEP 2)
(if (and
(not DCL_ID)
(minusp (setq DCL_ID (load_dialog "DD2OF")))
)
(exit)
)
(if (not (new_dialog "DD2OF" DCL_ID))
(exit)
)
(if OF_LAY
(progn
(set_tile "chlay" "1")
(mode_tile "layerlist" 0)
(MK_LIST)
)
(progn
(set_tile "chlay" "0")
(mode_tile "layerlist" 1)
)
)
(if OF_E
(set_tile "delold" "1")
(set_tile "delold" "0")
)
(if OF_DIST
(set_tile "ofdist" (rtos OF_DIST))
)
(action_tile "chlay" "(chlay_act)")
(action_tile "accept" "(accept_option)")
(action_tile "no" "(done_dialog 0)")
(action_tile "pickdis" "(done_dialog 4)")
(setq NEXT_STEP (start_dialog))
(if (= NEXT_STEP 4)
(setq OF_DIST (getdist "\nOffset distanc: "))
)
)
)
(defun CHLAY_ACT ()
(if (= (get_tile "chlay") "0")
(progn
(start_list "layerlist")
(end_list)
(mode_tile "layerlist" 1)
)
(progn
(mode_tile "layerlist" 0)
(MK_LIST)
)
)
)
(defun ACCEPT_OPTION ()
(if (= (get_tile "chlay") "0")
(setq OF_LAY NIL)
(setq OF_LAY (nth (atoi (get_tile "layerlist")) LAYER_LIST))
)
(if (= (get_tile "delold") "1")
(setq OF_E 1)
(setq OF_E NIL)
)
(setq DIST (distof (get_tile "ofdist")))
(done_dialog 1)
)
(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
(setq LAYER_LIST
(append
LAYER_LIST
(list LAYER_NAME)
)
)
)
(setq LAYER_NAME (cdr (assoc 2 (tblnext "layer"))))
)
(setq LAYER_LIST (acad_strlsort LAYER_LIST))
(if OF_LAY
(setq LAYER_LIST
(append
(list OF_LAY)
LAYER_LIST
)
)
)
(start_list "layerlist")
(mapcar
'add_list
LAYER_LIST
)
(end_list)
)
(defun PTLAY (X Y)
(if Y
(vla-put-layer
(car (vlax-safearray->list (vlax-variant-value X)))
Y
)
)
)
(defun C:2Q (/ OBJ SS)
(vl-load-com)
(if OF_DIST
(progn
(if OF_LAY
(princ (strcat "\n目标图层: " (strcase OF_LAY) ", "))
(princ "\n保留原图层, ")
)
(if OF_E
(princ "删除原线段, ")
(princ "保留原线段, ")
)
(princ "偏移距离: ")
(if OF_DIST
(princ OF_DIST)
(princ "0.0")
)
(initget "Option")
(setq KWD (getkword "\n设置(O)/<选择>: "))
(if (= KWD "Option")
(2OF_OPTION)
)
)
(2OF_OPTION)
)
(XD-CLEARCSET)
(setq SS (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))
(if SS
(progn
(vlax-for OBJ (vla-get-activeselectionset
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(PTLAY (vla-offset OBJ DIST) OF_LAY)
(PTLAY
(vla-offset
OBJ
(* DIST -1)
)
OF_LAY
)
)
(setq OF_DIST DIST)
(if OF_E
(progn
(setvar "cmdecho" 0)
(command "erase" SS "")
(setvar "cmdecho" 1)
)
)
)
)
(princ)
)
;;http://www.xdcad.net/forum/showthread.php?s=&threadid=454619
(defun XD-CLEARCSET (/ CSET)
(if (not (vl-catch-all-error-p
(setq CSET
(vl-catch-all-apply
'vla-item
(list
(vla-get-selectionsets
(vla-get-activedocument (vlax-get-acad-object))
)
"CURRENT"
)
)
)
)
)
(vla-delete CSET)
)
(princ)
)
(princ)

(defun 2OF_OPTION (/ DCL_ID LAYER_LIST NEXT_STEP)
  (setq NEXT_STEP 2)
  (while (>= NEXT_STEP 2)
    (if (and
   (not DCL_ID)
   (minusp (setq DCL_ID (load_dialog "DD2OF")))
 )
      (exit)
    )
    (if (not (new_dialog "DD2OF" DCL_ID))
      (exit)
    )
    (if OF_LAY
      (progn
 (set_tile "chlay" "1")
 (mode_tile "layerlist" 0)
 (MK_LIST)
      )
      (progn
 (set_tile "chlay" "0")
 (mode_tile "layerlist" 1)
      )
    )
    (if OF_E
      (set_tile "delold" "1")
      (set_tile "delold" "0")
    )
    (if OF_DIST
      (set_tile "ofdist" (rtos OF_DIST))
    )
    (action_tile "chlay" "(chlay_act)")
    (action_tile "accept" "(accept_option)")
    (action_tile "no" "(done_dialog 0)")
    (action_tile "pickdis" "(done_dialog 4)")
    (setq NEXT_STEP (start_dialog))
    (if (= NEXT_STEP 4)
      (setq OF_DIST (getdist "\nOffset distanc: "))
    )
  )
)
(defun CHLAY_ACT ()
  (if (= (get_tile "chlay") "0")
    (progn
      (start_list "layerlist")
      (end_list)
      (mode_tile "layerlist" 1)
    )
    (progn
      (mode_tile "layerlist" 0)
      (MK_LIST)
    )
  )
)
(defun ACCEPT_OPTION ()
  (if (= (get_tile "chlay") "0")
    (setq OF_LAY NIL)
    (setq OF_LAY (nth (atoi (get_tile "layerlist")) LAYER_LIST))
  )
  (if (= (get_tile "delold") "1")
    (setq OF_E 1)
    (setq OF_E NIL)
  )
  (setq DIST (distof (get_tile "ofdist")))
  (done_dialog 1)
)
(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
      (setq LAYER_LIST
      (append
        LAYER_LIST
        (list LAYER_NAME)
      )
      )
    )
    (setq LAYER_NAME (cdr (assoc 2 (tblnext "layer"))))
  )
  (setq LAYER_LIST (acad_strlsort LAYER_LIST))
  (if OF_LAY
    (setq LAYER_LIST
    (append
      (list OF_LAY)
      LAYER_LIST
    )
    )
  )
  (start_list "layerlist")
  (mapcar
    'add_list
    LAYER_LIST
  )
  (end_list)
)
(defun PTLAY (X Y)
  (if Y
    (vla-put-layer
      (car (vlax-safearray->list (vlax-variant-value X)))
      Y
    )
  )
)
(defun C:2Q (/ OBJ SS)
  (vl-load-com)
  (if OF_DIST
    (progn
      (if OF_LAY
 (princ (strcat "\n目标图层: " (strcase OF_LAY) ", "))
 (princ "\n保留原图层, ")
      )
      (if OF_E
 (princ "删除原线段, ")
 (princ "保留原线段, ")
      )
      (princ "偏移距离: ")
      (if OF_DIST
 (princ OF_DIST)
 (princ "0.0")
      )
      (initget "Option")
      (setq KWD (getkword "\n设置(O)/<选择>: "))
      (if (= KWD "Option")
 (2OF_OPTION)
      )
    )
    (2OF_OPTION)
  )
  (XD-CLEARCSET)
  (setq SS (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))
  (if SS
    (progn
      (vlax-for OBJ (vla-get-activeselectionset
        (vla-get-activedocument
   (vlax-get-acad-object)
        )
      )
 (PTLAY (vla-offset OBJ DIST) OF_LAY)
 (PTLAY
   (vla-offset
     OBJ
     (* DIST -1)
   )
   OF_LAY
 )
      )
      (setq OF_DIST DIST)
      (if OF_E
 (progn
   (setvar "cmdecho" 0)
   (command "erase" SS "")
   (setvar "cmdecho" 1)
 )
      )
    )
  )
  (princ)
)
;;http://www.xdcad.net/forum/showthread.php?s=&threadid=454619
(defun XD-CLEARCSET (/ CSET)
  (if (not (vl-catch-all-error-p
      (setq CSET
      (vl-catch-all-apply
        'vla-item
        (list
   (vla-get-selectionsets
     (vla-get-activedocument (vlax-get-acad-object)) 
   )
   "CURRENT"
        )
      )
      )
    )
      )
    (vla-delete CSET)
  )
  (princ)
)
(princ)

userzhl · 发表于 2006-1-13 20:52

龙兄，再帮忙看看12楼的这个程序，为何有时会出错呢？

ljpnb · 发表于 2006-1-13 21:26

我感觉程序中这句始终有问题(PTLAY (vla-offset OBJ (* DIST -1)) OF_LAY )

不知道楼主原先贴的那个程序问题解决了吗？

userzhl · 发表于 2006-1-13 22:57

楼上，我也不知道，先用用看还有没有问题，因我也不知道它是在什么情况下出问题的，只能拿龙兄的也试一下先！

ljpnb · 发表于 2006-1-14 08:00

当偏移的不是直线，比如圆弧，如果圆弧半径R=5，而的偏移距离为6，就会出现1楼的错误。

userzhl · 发表于 2006-1-14 08:55

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

楼上，情况不是像你说的这样的，但只是偶尔出现这种情况，重新打开CAD程序又没有问题了。

龙兄，帮忙看看这段程序错在哪里呀(有时真的是乱来的，根本没法用)：

;★长度型标注断开
(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)
)

龙龙仔 · 发表于 2006-1-16 17:15

把抓取关闭试试

userzhl · 发表于 2006-1-16 17:37

龙兄，老弟不明白呀，你能不能把它改好发上来给大家学习呢？

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