Community
1-iwant select(horizontal/vertical)dimention then select all object interscet it
1. Are those dimensions with their extension lines suppressed? And do you want to find anything that crosses the dimension/text line, that is, the straight line between arrows/ticks? If extension lines are not suppressed, do you want to find anything that crosses them, also?
2. Would it ever be needed for other-than-linear Dimensions [angular, diameter, radius, ordinate]?
Kent Cooper, AIA 
@the_ameral wrote:
... select(horizontal/vertical)dimention then select all object interscet it
Here you go
(Defun c:iMarker ( / highlighted _Allpoints opt ang ss i ev pts LinesThatCross ipts ipt)
;; pBe Jul 2021 ;;
(defun _Allpoints (en / param lst)
(if en
(if (eq (setq param (vlax-curve-getEndParam en)) (fix param))
(repeat (setq param (1+ (fix param)))
(setq lst (cons (vlax-curve-getPointAtParam en (setq param (1- param))) lst))
)
(list (vlax-curve-getStartPoint en) (vlax-curve-getEndPoint en))
)
)
)
(initget 1 "H V")
(setq opt (getkword "\nSelect option [Horizontal/Vertical]: "))
(setq ang (if (eq opt "H") (list 0.0 pi)
(list (* pi 0.5) (* pi 1.5))))
(if (And
(tblsearch "BLOCK" "marker")
(setq highlighted (ssadd)
ss (ssget "_X" (list '(0 . "DIMENSION")
'(-4 . "<OR")
'(70 . 0) (cons 50 (Car ang))
'(70 . 0) (cons 50 (Cadr ang))
'(-4 . "OR>"))))
)
(repeat (setq i (sslength ss))
(setq ev (ssname ss (setq i (1- i))))
(setq pts (mapcar '(lambda (d)
(cdr (assoc d (entget ev))))
'(13 14)))
(if (setq LinesThatCross
(ssget "F" pts '((0 . "*LINE"))))
(repeat (setq n (sslength LinesThatCross))
(setq en (ssname LinesThatCross (setq n (1- n))))
(setq ipts (_Allpoints en))
(ssadd en highlighted)
(vl-some '(lambda (a b)
(setq ipt (inters (Car pts)(cadr pts) a b)))
ipts (cdr ipts))
(entmakex (list (cons 0 "INSERT")
(cons 2 "marker")
(cons 10 ipt)
(cons 8 "AACE-RFT TOP")
)
)
)
)
)
)
(sssetfirst nil highlighted)
(princ)
)
Command: IMARKER
Select option [Horizontal/Vertical]: v
Command: IMARKER
Select option [Horizontal/Vertical]: H
HTH
@Sea-Haven wrote:(setq pt1 (cdr (assoc 13 ent)) Pt2 (cdr (assoc 14 ent)) )
The 13 and 14 codes do not necessarily store the locations you want, if I understand correctly. They are the definition points between which the Dimension measures, not always the arrowhead locations. If [as happens to be the case in your sample drawing, but I assume would not always be the case] the definition points are aligned in the dimension-line direction and the dimension line location is placed at the definition points, then 13 and 14 will do. This is why I asked about whether extension lines should be considered if they are not suppressed -- they run from the 13 & 14 locations to the arrowheads [adjusted by dimension-line offset and extension values].
The arrowhead location at the definition-point-2 end is code 10. The arrowhead location at the definition-point-1 end is not stored in entity data, but needs to be calculated. Here's one [edited from another routine of mine] that does that, even if the definition points are away from the dimension line, and even if by different distances. It works on not only Horizontal and Vertical Dimensions, but also Rotated and Aligned Dimensions at any angle. So far, it asks you to select a Dimension [that is what Message 1 asks for], but it can be expanded to let you select more than one, or to find all Horizontal or Vertical ones for you. First see whether it finds what you are looking for with a single Dimension. [Minimally tested.]
(defun dd (num); entity data dxf value associated with num
(cdr (assoc num ddata))
); defun - dd
(defun C:DIMCROSS
(/ dent ddata dobj dtyp def1 def2 arpt2 ddir arpt1)
(if
(and
(setq
dent (car (entsel "\nSelect linear Dimension: "))
ddata (entget dent)
); setq
(= (dd 0) "DIMENSION")
(setq
dobj (vlax-ename->vla-object dent)
dtyp (substr (vla-get-ObjectName dobj) 5 2); first two after AcDb prefix
; either "Ro"tated [including linear/horiz/vert], "Al"igned, "Di"ametric,
; "Ra"dial, "2L"ineAngular, "3P"ointAngular, "Or"dinate, or "Le"ader
); setq
(wcmatch dtyp "Ro,Al"); linear types only
); and
(progn ; then
(setq
def1 (dd 13); definition point 1
def2 (dd 14); definition point 2
arpt2 (dd 10); arrow-point/end of dimension line at extension line 2
ddir ; direction of dimension line
(if (= dtyp "Al"); aligned dimension always has (50 . 0.0), so
(angle def1 def2); then -- direction between definition points
(dd 50); else -- direction of dimension line
); if & ddir
arpt1; not in entity data for linear - must calculate
(cond ; [first condition def2=arpt2 results in arpt1=nil if ddir=0]
((equal def2 arpt2 1e-8); assuming NOT obliqued [wouldn't make much sense to]
(inters
arpt2
(polar arpt2 ddir 1); in direction of dimension line
def1
(polar def1 (+ ddir (/ pi 2)) 1); in direction of extension lines, if any
nil
); inters
); def2=arpt2 condition
(T ; otherwise
(inters
arpt2
(polar arpt2 ddir 1); in direction of dimension line
def1
(polar def1 (angle def2 arpt2) 1)
; in direction of extension lines [accounts for obliquing when arpt2 /= def2]
nil
); inters
); otherwise condition
); cond & arpt1
); setq
(sssetfirst nil (ssget "_F" (list arpt1 arpt2))); find/select intersecting object(s)
); progn
); if
(princ)
); defun
Kent Cooper, AIA
@the_ameral wrote:
IT SELECT ONLY ONE DIM IWANT IT SELECT MANY DIM
Yes, I said it could be adjusted to allow multiple selection. I will assume it does what you want for a single one, so it's worth the trouble to adjust it:
(defun dd (num); entity data dxf value associated with num
(cdr (assoc num ddata))
); defun - dd
(defun C:DIMCROSS
(/ dimcss ss n dent ddata dobj dtyp def1 def2 arpt2 ddir arpt1 dcss i)
(setq dimcss (ssadd)); initially empty
(if (setq ss (ssget '((0 . "DIMENSION"))))
(progn ; then
(repeat (setq n (sslength ss)); then
(setq
dent (ssname ss (setq n (1- n)))
ddata (entget dent)
dobj (vlax-ename->vla-object dent)
dtyp (substr (vla-get-ObjectName dobj) 5 2); first two after AcDb prefix
; either "Ro"tated [including linear/horiz/vert], "Al"igned, "Di"ametric,
; "Ra"dial, "2L"ineAngular, "3P"ointAngular, "Or"dinate, or "Le"ader
); setq
(if (wcmatch dtyp "Ro,Al"); linear types only
(progn ; then
(setq
def1 (dd 13); definition point 1
def2 (dd 14); definition point 2
arpt2 (dd 10); arrow-point/end of dimension line at extension line 2
ddir ; direction of dimension line
(if (= dtyp "Al"); aligned dimension always has (50 . 0.0), so
(angle def1 def2); then -- direction between definition points
(dd 50); else -- direction of dimension line
); if & ddir
arpt1; not in entity data for linear - must calculate
(cond ; [first condition def2=arpt2 results in arpt1=nil if ddir=0]
((equal def2 arpt2 1e-8); assuming NOT obliqued [wouldn't make much sense to]
(inters
arpt2
(polar arpt2 ddir 1); in direction of dimension line
def1
(polar def1 (+ ddir (/ pi 2)) 1); in direction of extension lines, if any
nil
); inters
); def2=arpt2 condition
(T ; otherwise
(inters
arpt2
(polar arpt2 ddir 1); in direction of dimension line
def1
(polar def1 (angle def2 arpt2) 1)
; in direction of extension lines [accounts for obliquing when arpt2 /= def2]
nil
); inters
); otherwise condition
); cond & arpt1
dcss (ssget "_f" (list arpt1 arpt2))
); setq
(repeat (setq i (sslength dcss))
(ssadd (ssname dcss (setq i (1- i))) dimcss); add each to larger set
); repeat
); progn
); if
); repeat
(sssetfirst nil dimcss); select/highlight/grip intersecting object(s)
); progn
); if
(princ)
); defun
Kent Cooper, AIA
@the_ameral wrote:
... SELECT SPECIFIC DIM NOT ALL
Remove "_X" from this line then you're good to go.
(setq highlighted (ssadd)
ss (ssget "_X" (list '(0 . "DIMENSION")
'(-4 . "<OR")
'(70 . 0) (cons 50 (Car ang))
'(70 . 0) (cons 50 (Cadr ang))
'(-4 . "OR>"))))
)
HTH
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
