Connect attribiute block with lines by Description text

[Guest]

Hi .i am using block attribiutes for my topografic drawings. I use two type of blocks (annotation and non annotation). From stations i use AnnotSTATION,STATION and for the other points i use  AnnotPoint,Point. Each block has POINT,ELEV,DESC (like img 2). I want to connent with line  for example the station K1 with DESC S1 with all points with DESC S1 . The idea is to conect with line the AnnotSTATION,STATION block with the AnnotPoint,Point with only filter the same DESC name.

 

Thanks

TEST.dwg STATION.dwg Point.dwg AnnotSTATION.dwg AnnotPoint.dwg

[Trudy]

Hello, i dont know if this is what you looking for but you can try it.

First select is for Staion points.

Second select is for Base points.

command: try1

(defun VaniVL ( SS SSnm / i L SScoll SfArrayObjs vSS )
  (cond
    ( (not (eq 'PICKSET (type SS))) nil)
    ( (not (and (eq 'STR (type SSnm)) (snvalid SSnm))) nil)
    (T
      (repeat (setq i (sslength SS))
        (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L))
      )
      (setq SScoll (vla-get-SelectionSets (vla-get-ActiveDocument (vlax-get-acad-object))))
      (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list SScoll SSnm))))
        (vla-Delete (vla-Item SScoll SSnm))
      )
      (setq vSS (vla-Add SScoll SSnm))
      (setq SfArrayObjs (vlax-make-safearray vlax-vbObject (cons 0 (1- (length L)))))
      (setq i -1)
      (foreach o L (vlax-safearray-put-element SfArrayObjs (setq i (1+ i)) o) )
      (vla-AddItems vSS SfArrayObjs)
      vSS
    )
  ); cond
); defun VanillaSS->VlaSS

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)

(defun c:try1 ( / sel2 sspoints ssbase sscord2)	

	(setq sscord2 (ssget (list (cons 0 "Insert")(cons 2 "Annotstation"))))
	(setq ssbase (VaniVL sscord2 "Try11"))
	
	(setq sel2 (ssget (list (cons 0 "Insert")(cons 2 "Annotpoint"))))
	(setq sspoints (VaniVL sel2 "Try12"))
	
(vlax-for x ssbase
	(vlax-for y sspoints 
		(if (equal (LM:vl-getattributevalue x "DESC") (LM:vl-getattributevalue y "DESC"))
			(progn
				(T:eLine (vlax-get x 'InsertionPoint) (vlax-get y 'InsertionPoint))
			)
		)
	)
)
(princ)
)

(defun T:eLine (P1 P2 /)
	;entmake lin in Layout- Zero line
	(entmake (list (cons 0 "LINE")
					(cons 8 "FRAME-LINES")
					(cons 10 P1)
					(cons 11 P2)
			  )
	)
)

 

Edited July 23, 2021 by Trudy

[Guest]

Hi Trudy. I select first all the stations and then all the points and work. Is it possible to run the command and search what block are in the drawing and connect them , because sometimes the drawings are big with a lot of poins and is not easy to find all the stations.

 

Thanks

[Guest]

I try to change the color in the layer  to 20 but the default color in the layer is 0 and change only the color of the line to 20 ??? why??

 

(defun T:eLine (P1 P2 /)
	;entmake lin in Layout- Zero line
	(entmake (list (cons 0 "LINE")
					(cons 8 "FRAME-LINES")
					(cons 62 20) ;Change color to 20
					(cons 10 P1)
					(cons 11 P2)
			  )
	)
)

 

[Trudy]

Something like this ?

(defun c:try1 ( / sel2 sspoints ssbase sscord2)	
	(vl-cmdf "._Layer" "Color" 20 "FRAME-LINES" "");color change for layer
	(setq sscord2 (ssget "X"(list (cons 0 "Insert")(cons 2 "Annotstation"))))
	(setq ssbase (VaniVL sscord2 "Try11"))
	
	(setq sel2 (ssget "X" (list (cons 0 "Insert")(cons 2 "Annotpoint"))))
	(setq sspoints (VaniVL sel2 "Try12"))
	
(vlax-for x ssbase
	(vlax-for y sspoints 
		(if (equal (LM:vl-getattributevalue x "DESC") (LM:vl-getattributevalue y "DESC"))
			(progn
				(T:eLine (vlax-get x 'InsertionPoint) (vlax-get y 'InsertionPoint))
			)
		)
	)
)
(princ)
)

 

[Guest]

Thanks Trudy. Works fine

[Guest]

Hi Trudy. is it possible if Annotstation  is missing to add an alert box say that  "Annotstation Block is Missing !!!!!"

 

Thanks

 

[Guest]

Any ideas?

[BIGAL]

(tblsearch "block"  "Annotstation")

[Guest]

Thanks BIGAL

[Guest]

Hi BIGAL i try this. I believe that this works  but is not wprking properly. I try to use it and the i have already the Annotstation in my drawing and gives me the alert that is not exist !!! Any ideas?

 

 

(defun c:try1 ( / sel2 sspoints ssbase sscord2)	
	(vl-cmdf "._Layer" "Color" 20 "FRAME-LINES" "");color change for layer
    
; check for Annotstation  
(if (tblsearch "block" "Annotstation")
  (alert "The Annotstation does not exist !!!")
  ) ; end if


	(setq sscord2 (ssget "X"(list (cons 0 "Insert")(cons 2 "Annotstation"))))
	(setq ssbase (VaniVL sscord2 "Try11"))
	
	(setq sel2 (ssget "X" (list (cons 0 "Insert")(cons 2 "Annotpoint"))))
	(setq sspoints (VaniVL sel2 "Try12"))
	
(vlax-for x ssbase
	(vlax-for y sspoints 
		(if (equal (LM:vl-getattributevalue x "DESC") (LM:vl-getattributevalue y "DESC"))
			(progn
				(T:eLine (vlax-get x 'InsertionPoint) (vlax-get y 'InsertionPoint))
			)
		)
	)
)
(princ)
)

 

Thanks

Edited August 7, 2021 by prodromosm

[confutatis]

Basically you wrote if there is a block, you write the message that there is no block! This is the correct syntax:

 

; check for Annotstation  
(if (NOT (tblsearch "block" "Annotstation"))
 (alert "The Annotstation does not exist !!!")
) ; end if

 

[Guest]

Thanks confutatis

[Guest]

I have a similar problem with another code  . I did the same changes but i want to stop the rutine if the dimension style does not exist, because gives me the alert that the dimstyle does not exist but the code continious with the  curent dimstyle

 

(defun c:dimTOPO ()


(if (NOT (tblsearch "dimstyle" "_TOPO"))
  (alert "The Dimstyle _TOPO does not exist")
  ) ; end if
	
 (command "_layer" "_m" "DIM" "_c" "7" "" "_lw" "0.30" "" "") ;CREATE NEW LAYER
 (setvar "CLAYER" "DIM")
 (command "-DIMSTYLE" "R" "_TOPO")
 (command "dimaligned")
)

 

[confutatis]

(if (NOT (tblsearch "dimstyle" "_TOPO"))
  (vl-exit-with-error (alert "The Dimstyle _TOPO does not exist"))
  ) ; end if

 

Edited August 7, 2021 by confutatis

[Guest]

Thanks confutatis