(defun c:int_dist (/ *error* isCurveObj ss->list vlax-list->3D-point SortFromPt SortbyParam
DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG X Y
)
(vl-load-com)
;; Lee Mac~04.03.10
(setq *doc (cond (*doc) ((vla-get-ActiveDocument
(vlax-get-acad-object)))))
(defun *error* (msg)
(and uFlag (vla-EndUndoMark *doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
) ;_or
(princ)
) ;_defun
(defun isCurveObj (ent)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
vlax-curve-getEndParam
) ;_function
(list ent)
) ;_vl-catch-all-apply
) ;_vl-catch-all-error-p
) ;_not
) ;_defun
(defun ss->list (ss / i ent ObjLst)
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ObjLst
(cons
(vlax-ename->vla-object ent)
Objlst
) ;_cons
) ;_setq
) ;_while
ObjLst
) ;_defun
(defun vlax-list->3D-point (lst)
(if lst
(cons (list (car lst) (cadr lst) (caddr lst))
(vlax-list->3D-point (cdddr lst))
) ;_cons
) ;_if
) ;_defun
(defun SortFromPt (pt lst)
(vl-sort lst
(function
(lambda (a b)
(< (distance a pt)
(distance b pt)
) ;_<
) ;_lambda
) ;_function
) ;_vl-sort
) ;_defun
(defun SortByParam (ent lst)
(vl-sort lst
(function
(lambda (a b)
(< (vlax-curve-getParamatPoint
ent
a
) ;_vlax-curve-getParamatPoint
(vlax-curve-getParamatPoint
ent
b
) ;_vlax-curve-getParamatPoint
) ;_<
) ;_lambda
) ;_function
) ;_vl-sort
) ;_defun
(while
(progn
(setq ent (car (entsel)))
(cond ((eq 'ENAME (type ent))
(if (isCurveObj ent)
(progn
(vla-getBoundingBox
(setq obj
(vlax-ename->vla-object ent)
) ;_setq
'Mi
'Ma
) ;_vla-getBoundingBox
(mapcar
(function set)
'(Mi Ma)
(mapcar
(function
vlax-safearray->list
) ;_function
(list Mi Ma)
) ;_mapcar
) ;_mapcar
(setq ss
(ssget "_C"
(list (car Mi) (cadr Ma) 0.)
(list (car Ma) (cadr Mi) 0.)
) ;_ssget
) ;_setq
(if
(and
(setq iLst
(apply
(function
append
) ;_function
(vl-remove 'nil
(mapcar
(function
(lambda (x)
(vlax-list->3D-point
(vlax-invoke
obj
'IntersectWith
x
acExtendNone
) ;_vlax-invoke
) ;_vlax-list->3D-point
) ;_lambda
) ;_function
(ss->list
(ssdel ent ss)
) ;_ss->list
) ;_mapcar
) ;_vl-remove
) ;_apply
) ;_setq
(< 1 (length iLst))
) ;_and
(progn
(setq uFlag
(not
(vla-StartUndoMark *doc)
) ;_not
) ;_setq
(setq iLst (SortByParam
ent
iLst
) ;_SortFromPt
) ;_setq
(or
(equal
(vlax-curve-getStartParam ent)
(vlax-curve-getParamatPoint
ent
(car iLst)
) ;_vlax-curve-getParamatPoint
0.001
) ;_equal
(setq iLst
(cons
(vlax-curve-getStartPoint ent)
iLst
) ;_cons
) ;_setq
) ;_or
(or
(equal
(vlax-curve-getEndParam ent)
(vlax-curve-getParamatPoint
ent
(last iLst)
) ;_vlax-curve-getParamatPoint
0.001
) ;_equal
(setq iLst
(append iLst
(list
(vlax-curve-getEndPoint ent)
) ;_list
) ;_append
) ;_setq
) ;_or
(while
(cadr iLst)
(setq x (car iLst)
y (cadr iLst)
) ;_setq
(setq mPt
(vlax-curve-getPointatDist
ent
(/
(+
(vlax-curve-getDistatPoint
ent
y
) ;_vlax-curve-getDistatPoint
(vlax-curve-getDistAtPoint
ent
x
) ;_vlax-curve-getDistAtPoint
) ;_-
2.
) ;_/
) ;_vlax-curve-getPointatDist
) ;_setq
(setq dist
(abs
(-
(vlax-curve-getDistatPoint
ent
y
) ;_vlax-curve-getDistatPoint
(vlax-curve-getDistAtPoint
ent
x
) ;_vlax-curve-getDistAtPoint
) ;_-
) ;_abs
) ;_setq
(setq lAng
(angle '(0 0 0)
(vlax-curve-getFirstDeriv
ent
(vlax-curve-getParamatPoint
ent
mPt
) ;_vlax-curve-getParamatPoint
) ;_vlax-curve-getFirstDeriv
) ;_angle
) ;_setq
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi))
)
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))
)
) ;_cond
(setq tObj
(vla-AddText
(if
(zerop
(vla-get-ActiveSpace *doc)
) ;_zerop
(if
(eq :vlax-true
(vla-get-MSpace *doc_)
) ;_eq
(vla-get-ModelSpace *doc)
(vla-get-PaperSpace *doc)
) ;_if
(vla-get-ModelSpace *doc)
) ;_if
(rtos dist)
(vlax-3D-point
'(0 0 0)
) ;_vlax-3D-point
(getvar 'TEXTSIZE)
) ;_vla-AddText
) ;_setq
(vla-put-Alignment tObj acAlignmentMiddleCenter)
(vla-put-TextAlignmentPoint
tObj
(vlax-3D-point
(polar mPt
(+ lAng (/ pi 2.))
(getvar 'TEXTSIZE)
) ;_polar
) ;_vlax-3D-point
) ;_vla-put-TextAlignmentPoint
(vla-put-rotation tObj lAng)
(setq iLst (cdr iLst))
) ;_while
(setq uFlag
(vla-EndUndomark *doc)
) ;_setq
) ;_progn
(princ "\n** Object Has less than Two Intersections **")
) ;_if
) ;_progn
(princ "\n** Invalid Object Selected **")
) ;_if
)
) ;_cond
) ;_progn
) ;_while
(princ)
) ;_defun
值得思考。
使用多行文字。。。
(or *doc (setq *doc (vla-get-activedocument (vlax-get-acad-object))))
在这种情况下，哪一种可能更好。
李
不客气，庞蒂费克斯我玩得很开心 Ok, previous code updated to reflect Alan's bug spot
Give it a try now Pontifex This should perform as required:
(defun c:int_dist (/ *error* isCurveObj ss->list vlax-list->3D-point SortFromPt DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG ) (vl-load-com) ;; Lee Mac~04.03.10 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))) (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) ;_or (princ) ) ;_defun (defun isCurveObj (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam ) ;_function (list ent) ) ;_vl-catch-all-apply ) ;_vl-catch-all-error-p ) ;_not ) ;_defun (defun ss->list (ss / i ent ObjLst) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (setq ObjLst (cons (vlax-ename->vla-object ent) Objlst ) ;_cons ) ;_setq ) ;_while ObjLst ) ;_defun (defun vlax-list->3D-point (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (vlax-list->3D-point (cdddr lst)) ) ;_cons ) ;_if ) ;_defun (defun SortFromPt (pt lst) (vl-sort lst (function (lambda (a b) (< (distance a pt) (distance b pt) ) ;_< ) ;_lambda ) ;_function ) ;_vl-sort ) ;_defun (while (progn (setq ent (entsel) pt(cadr ent) ent (car ent) ) ;_setq (cond ((eq 'ENAME (type ent)) (if (isCurveObj ent) (progn (vla-getBoundingBox (setq obj (vlax-ename->vla-object ent) ) ;_setq 'Mi 'Ma ) ;_vla-getBoundingBox (mapcar (function set) '(Mi Ma) (mapcar (function vlax-safearray->list ) ;_function (list Mi Ma) ) ;_mapcar ) ;_mapcar (setq ss (ssget "_C" (list (car Mi) (cadr Ma) 0.) (list (car Ma) (cadr Mi) 0.) ) ;_ssget ) ;_setq (if (and (setq iLst (apply (function append ) ;_function (vl-remove 'nil (mapcar (function (lambda (x) (vlax-list->3D-point (vlax-invoke obj 'IntersectWith x acExtendNone ) ;_vlax-invoke ) ;_vlax-list->3D-point ) ;_lambda ) ;_function (ss->list (ssdel ent ss) ) ;_ss->list ) ;_mapcar ) ;_vl-remove ) ;_apply ) ;_setq (< 1 (length iLst)) ) ;_and (progn (setq uFlag (not (vla-StartUndoMark *doc) ) ;_not ) ;_setq (setq iLst (SortFromPt (vlax-curve-getClosestPointto ent pt) iLst ) ;_SortFromPt iLst (list (car iLst) (cadr iLst)) ) ;_setq (setq mPt (vlax-curve-getPointatDist ent (/ (+ (vlax-curve-getDistatPoint ent (cadr iLst) ) ;_vlax-curve-getDistatPoint (vlax-curve-getDistAtPoint ent (car ilst) ) ;_vlax-curve-getDistAtPoint ) ;_- 2. ) ;_/ ) ;_vlax-curve-getPointatDist ) ;_setq (setq dist (abs (- (vlax-curve-getDistatPoint ent (cadr iLst) ) ;_vlax-curve-getDistatPoint (vlax-curve-getDistAtPoint ent (car ilst) ) ;_vlax-curve-getDistAtPoint ) ;_- ) ;_abs ) ;_setq (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent mPt ) ;_vlax-curve-getParamatPoint ) ;_vlax-curve-getFirstDeriv ) ;_angle ) ;_setq (cond ((and (> lAng (/ pi 2)) ( lAng pi) ( Lee, if you use MText, you can avoid the worry of dealing with annotative text. If you did want to use DText, you could just check to see if the style is annotative then use this instead...
(* (/ 1 (getvar 'cannoscalevalue)) (getvar 'textsize))Food for thought.
With MText...
(defun c:test (/ *error* isCurveObj ss->list vlax-list->3D-point SortFromPt SortbyParam DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG X Y ) (vl-load-com) ;; Lee Mac~04.03.10 (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) ;_or (princ) ) ;_defun (defun isCurveObj (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam ) ;_function (list ent) ) ;_vl-catch-all-apply ) ;_vl-catch-all-error-p ) ;_not ) ;_defun (defun ss->list (ss / i ent ObjLst) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (setq ObjLst (cons (vlax-ename->vla-object ent) Objlst ) ;_cons ) ;_setq ) ;_while ObjLst ) ;_defun (defun vlax-list->3D-point (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (vlax-list->3D-point (cdddr lst)) ) ;_cons ) ;_if ) ;_defun (defun SortFromPt (pt lst) (vl-sort lst (function (lambda (a b) (< (distance a pt) (distance b pt) ) ;_< ) ;_lambda ) ;_function ) ;_vl-sort ) ;_defun (defun SortByParam (ent lst) (vl-sort lst (function (lambda (a b) (< (vlax-curve-getParamatPoint ent a ) ;_vlax-curve-getParamatPoint (vlax-curve-getParamatPoint ent b ) ;_vlax-curve-getParamatPoint ) ;_< ) ;_lambda ) ;_function ) ;_vl-sort ) ;_defun (or *doc (setq *doc (vla-get-activedocument (vlax-get-acad-object)))) (while (progn (setq ent (car (entsel))) (cond ((eq 'ENAME (type ent)) (if (isCurveObj ent) (progn (vla-getBoundingBox (setq obj (vlax-ename->vla-object ent) ) ;_setq 'Mi 'Ma ) ;_vla-getBoundingBox (mapcar (function set) '(Mi Ma) (mapcar (function vlax-safearray->list ) ;_function (list Mi Ma) ) ;_mapcar ) ;_mapcar (setq ss (ssget "_C" (list (car Mi) (cadr Ma) 0.) (list (car Ma) (cadr Mi) 0.) ) ;_ssget ) ;_setq (if (and (setq iLst (apply (function append ) ;_function (vl-remove 'nil (mapcar (function (lambda (x) (vlax-list->3D-point (vlax-invoke obj 'IntersectWith x acExtendNone ) ;_vlax-invoke ) ;_vlax-list->3D-point ) ;_lambda ) ;_function (ss->list (ssdel ent ss) ) ;_ss->list ) ;_mapcar ) ;_vl-remove ) ;_apply ) ;_setq (< 1 (length iLst)) ) ;_and (progn (setq uFlag (not (vla-StartUndoMark *doc) ) ;_not ) ;_setq (setq iLst (SortByParam ent iLst ) ;_SortFromPt ) ;_setq (or (equal (vlax-curve-getStartParam ent) (vlax-curve-getParamatPoint ent (car iLst) ) ;_vlax-curve-getParamatPoint 0.001 ) ;_equal (setq iLst (cons (vlax-curve-getStartPoint ent) iLst ) ;_cons ) ;_setq ) ;_or (or (equal (vlax-curve-getEndParam ent) (vlax-curve-getParamatPoint ent (last iLst) ) ;_vlax-curve-getParamatPoint 0.001 ) ;_equal (setq iLst (append iLst (list (vlax-curve-getEndPoint ent) ) ;_list ) ;_append ) ;_setq ) ;_or (while (cadr iLst) (setq x (car iLst) y (cadr iLst) ) ;_setq (setq mPt (vlax-curve-getPointatDist ent (/ (+ (vlax-curve-getDistatPoint ent y ) ;_vlax-curve-getDistatPoint (vlax-curve-getDistAtPoint ent x ) ;_vlax-curve-getDistAtPoint ) ;_- 2. ) ;_/ ) ;_vlax-curve-getPointatDist ) ;_setq (setq dist (abs (- (vlax-curve-getDistatPoint ent y ) ;_vlax-curve-getDistatPoint (vlax-curve-getDistAtPoint ent x ) ;_vlax-curve-getDistAtPoint ) ;_- ) ;_abs ) ;_setq (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent mPt ) ;_vlax-curve-getParamatPoint ) ;_vlax-curve-getFirstDeriv ) ;_angle ) ;_setq (cond ((and (> lAng (/ pi 2)) ( lAng pi) (
I don't like it when it's broken up that much. I set my margins to 100. everything works, both codes. PERFECT. Absolutely perfect. Now i have to test it. Thanks Lee and alanjt...again
Thanks Alan, I'm always at a loss as to what TextSize to use...
I've seen this also used:
(getvar 'DIMTXT)
Which may be better in this situation.
Lee
You're welcome PontifexI had fun with this one
页:
1
[2]