尺寸界线程序，无法运行，请求帮助
本帖最后由 尘缘一生 于 2017-8-24 10:25 编辑如题，写了个这个，无法运行，请求改动。其中：实体交点函数，取自本坛作品。
;;; -------------------------------------------------------------------------
(defun c:ccjx (/ ang1 pt1 pt3 pt4 pt5 pt7 pt8 ang e p n spname)
(setq spname (car (entsel "\n请选择标注尺寸线:")))
(if (= "LINE" (cdr (assoc 0 (entget spname))))
(progn
(setq pt1 (entget spname))
(setq pt3 (cdr (assoc 10 pt1)))
(setq pt4 (cdr (assoc 11 pt1)))
(setq ang (angle pt3 pt4))
)
)
(if (= "lwpolyline" (cdr (assoc 0 (entget spname))))
(progn
(setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点
(setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点
(setq ang (angle pt3 pt4))
)
)
(princ "\n 请选择所有尺寸定界线: ")
(setq e (ssget))
(setq p (sslength e))
(setq n 0)
(while (< n p)
(setq pt1 (obj_int spname (ssname e n)))
(setq pt7 (polar pt1 (+ (/ pi 4) ang) 0.71))
(setq pt8 (polar pt1 (+ (+ (/ pi 4) ang) pi) 0.71))
(command "_.PLINE" "non" pt7 "W" 0.45 0.45 "non" pt8 "")
(setq n (+ n 1))
)
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;功能:返回两个对象的所有交点
;参数: ent1、ent2 均为ename对象
(defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points (append points (list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)))
)
(setq i (+ 3 i))
)
)
points
)
函数obj_int 返回的是个点表
改成(setq pt1 (car (obj_int spname (ssname e n))))
修改调试成功
;;; ------------------------------------------------------------------------
(defun c:ccjx (/ pt1 pt3 pt4 ang e p n spname)
(setq spname (car (entsel "\n请选择标注尺寸线:")))
(if (= "LINE" (cdr (assoc 0 (entget spname))))
(progn
(setq pt1 (entget spname))
(setq pt3 (cdr (assoc 10 pt1)))
(setq pt4 (cdr (assoc 11 pt1)))
(setq ang (/ (* 180 (angle pt3 pt4)) pi))
)
)
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget spname))))
(progn
(setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点
(setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点
(setq ang (/ (* 180 (angle pt3 pt4)) pi))
)
)
(princ "\n 请选择所有尺寸定界线: ")
(setq e (ssget))
(setq p (sslength e))
(setq n 0)
(while (< n p)
(setq pt1 (car (obj_int spname (ssname e n))))
(command "-insert" "_archtick" pt1 1 1 ang)
(setq n (+ n 1))
)
)
;;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;; 功能:返回两个对象的所有交点
;;; 参数: ent1、ent2 均为ename对象
(defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1 (- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
) 3
)
(setq points (append
points
(list (list (vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints
(+ i 1)
) (vlax-safearray-get-element intpoints
(+ i 2)
)
)
)
)
)
(setq i (+ 3 i))
)
)
points
)
页:
[1]