Topic: One Line Diagram via copy F1

[T-Square]

Hello All,

Does anyone have a lisp routine that allows you to consecutively select existing blocks and copy it to another location in a one line format?

Thanks in advance!

[T-Square]

It's a start...

Code: [Select]

(defun c:ONELINE (/ DIMSC INSPT BLK1 BLKENT BLK2)
(setvar "attreq" 0)
(setq DIMSC(getvar "dimscale"))
(setq INSPT(getpoint "\nSelect One Line Start Point: "))
;;;
(setq BLK1(entsel "\nSelect A Block: "))
(if BLK1
(progn
(setq BLKENT(entget (car BLK1)))
(if (= (cdr (assoc 0 BLKENT)) "INSERT")
(progn
(setq BLK2(cdr (assoc 2 BLKENT)))
(command ".insert" BLK2 INSPT DIMSC DIMSC 0)
);progn
(princ "\nNot A Block... Please Select Again: ")
);if
);progn
(princ "\nNothing Selected... Please Select Again: ")
);if
(princ)
)

[T-Square]

Getting there...

Code: [Select]

(defun c:ONELINE (/ DIMSC BLK1 BLKENT BLK2)
(setvar "attreq" 0)
(setq DIMSC(getvar "dimscale"))
(setq INSPT(getpoint "\nSelect One Line Start Point: "))
;;;
(while
(setq BLK1(entsel "\nSelect A Block: "))
(if BLK1
(progn
(setq BLKENT(entget (car BLK1)))
(if (= (cdr (assoc 0 BLKENT)) "INSERT")
(progn
(setq BLK2(cdr (assoc 2 BLKENT)))
(command ".insert" BLK2 INSPT DIMSC DIMSC 0)
(setq INSPT(list (+ (car INSPT) (* DIMSC 0.75)) (- (cadr INSPT) 0.0)))
);progn
(princ "\nNot A Block... Please Select Again: ")
);if
);progn
(princ "\nNothing Selected... Please Select Again: ")
);if
);while
(princ)
)

[T-Square]

Works for me... Anyone care to critique... additions... subtractions?

"INITERR" & "RESET" are functions within my local error trap loaded at startup.

Code: [Select]

(defun c:ONELINE (/ DIMSC BLK1 BLKENT BLK2)
(INITERR)
(setvar "CMDECHO" 0)
(command ".undo" "end")
(command ".undo" "m")
(setvar "CECOLOR" "bylayer")
(setvar "CELTYPE" "bylayer")
(setvar "CELWEIGHT" -1)
(setvar "SNAPMODE" 0)
(setvar "ATTREQ" 0)
(graphscr)
;;;
(GETSPACE)
(MAKEONELINELAYER)
;;;
(setq INSPT(getpoint "\nSelect One Line Start Point: "))
;;;
(while
(setq BLK1(entsel "\nSelect A Block: "))
(if BLK1
(progn
(setq BLKENT(entget (car BLK1)))
(if (= (cdr (assoc 0 BLKENT)) "INSERT")
(progn
(setq BLK2(cdr (assoc 2 BLKENT)))
(command ".insert" BLK2 INSPT DIMSC DIMSC 0)
(setq INSPT(list (+ (car INSPT) (* DIMSC 0.75)) (- (cadr INSPT) 0.0)))
)
(princ "\nNot A Block... Please Select Again: ")
)
)
(princ "\nNothing Selected... Please Select Again: ")
)
)
;;;
(command ".undo" "end")
(RESET)
(princ)
)
;;;
;;;;;;;;;;Sub Functions
;;;
(defun GETSPACE (/)
(if (and (equal (getvar "TILEMODE") 0)
(equal (getvar "CVPORT") 1)
)
(setq CSPACE 1);paper space
(setq CSPACE 0);model space.
)
(if (= CSPACE 1)
(setq DIMSC 1.0)
(setq DIMSC(getvar "DIMSCALE"))
)
)
;;;
(defun MAKEONELINELAYER (/)
(setq LAY "YOURLAYERHERE")
;;;
(if (not (tblsearch "layer" LAY))
(command ".-layer" "thaw" LAY "on" LAY "unlock" LAY "make" LAY "color" "1" LAY "lt" "continuous" LAY "")
(progn
(princ (strcat "\nLayer " LAY " Already Exists... Layer Un-Changed... "))
(setvar "clayer" LAY)
)
)
)
Couple of things I am not sure if I want to tackle. Not all of my blocks are inserted about the center of the block. Thus, some are slightly off the center of the one line. Oh, and I can't remember how to keep the loop going if "Nothing Selected... Please Select Again" comes up.

[CAB]

I made a few changes, not knowing exactly what you are trying to acheave.

Code: [Select]

(defun c:ONELINE (/ DIMSC BLK1 BLKENT BLK2)
          ; (INITERR) ; ???
                 ;| turned off during debug
  (setvar "CMDECHO" 0)
  (command ".undo" "end")
  (command ".undo" "m")
  (setvar "CECOLOR" "bylayer")
  (setvar "CELTYPE" "bylayer")
  (setvar "CELWEIGHT" -1)
  (setvar "SNAPMODE" 0)
  (setvar "ATTREQ" 0)
  (graphscr) |;
;;;
  (setq DIMSC (GETDIMSCALE)) ; CAB
  (MAKEONELINELAYER "YOURLAYERHERE") ; CAB
;;;
  (if (setq INSPT (getpoint "\nSelect One Line Start Point: "))
    (while
      (cond
        ((null (setvar "ErrNo" 0))) ; reset var, cond never stops here
        ((and (setq BLK1 (entsel "\nSelect A Block: "))
              (setq BLKENT (entget (car BLK1)))
              (= (cdr (assoc 0 BLKENT)) "INSERT")
         )
         (setq BLK2 (cdr (assoc 2 BLKENT)))
         (command ".insert" BLK2 INSPT DIMSC DIMSC 0)
         (setq
           INSPT (list (+ (car INSPT) (* DIMSC 0.75)) (- (cadr INSPT) 0.0))
         )
        )

        ((= (getvar "errno") 52) (prompt "\nUser Quit.")) ; Exit on ENTER key
       
        (BLK1 (princ "\nNot A Block... Please Select Again: "))

        ((princ "\nNothing Selected... Please Select Again: "))
        ;; note that princ returns not nil
        ;;  using prompt will cause an exit from the loop
      )
    )
  )
;;;
  (command ".undo" "end")
          ; (RESET) ; ???
  (princ)
)


;;;
;;;;;;;;;;Sub Functions
;;;
(defun GETDIMSCALE () ; CAB revised
  (if (and (equal (getvar "TILEMODE") 0)
           (equal (getvar "CVPORT") 1)
      )
    1.0   ; paper space
    (getvar "DIMSCALE") ; model space.
  )
)
;;;
(defun MAKEONELINELAYER (LAY /) ; let the calling routine supply the layer
  ;;  (setq LAY "YOURLAYERHERE")
;;;
  (if (not (tblsearch "layer" LAY))
    (command ".-layer" "thaw" LAY "on" LAY "unlock" LAY "make" LAY "color" "1"
             LAY "lt" "continuous" LAY ""
            )
    (progn
      (princ (strcat "\nLayer " LAY " Already Exists... Layer Un-Changed... "))
      ;;(setvar "clayer" LAY)  <---<<  change this
      (command "._Layer" "_Thaw" LAY "_On" LAY "_UnLock" LAY "_Set" LAY "")
          ; to this
    )
  )
)

[tfpacad19]

CAB,

It has been a long time since I visited this one line topic.

Is there a way to modify the one line routine to utilize the "true" block name? I am using annotative/dynamic blocks now and the routine crashes when it encounters an anonymous block name.

I know this is a very old topic, I have started another job where I am utilizing this again.

Any help is appreciated.

Tim

[tfpacad19]

Hello all,

I have attached a dwg file showing a fire alarm block I have created. It is dynamic and annotative.

The problem I am having is how to pass the "actual" block name to the one line creation tool and not the anonymous block name.

I have included (3) different dwg versions for convenience.

Basically what I do is...

Convert room names from blocks/dtext/mtext to a combined mtext of the room name
Layout the devices
Create the one line by picking a start point and  then picking the block and it being added to the one line

Currently it does not select the room name, which would be a nice addition as I manually add this to the one line.

This would be a HUUUUUGE time saver for me.

If anyone can help me it would be greatly appreciated.

The attached code was created by CAB.

Code: [Select]

(defun c:ONELINE (/ DIMSC BLK1 BLKENT BLK2)
(INITERR)
(setvar "CMDECHO" 1)
(command ".undo" "end")
(command ".undo" "m")
(setvar "CECOLOR" "bylayer")
(setvar "CELTYPE" "bylayer")
(setvar "CELWEIGHT" -1)
(setvar "SNAPMODE" 0)
(setvar "ATTREQ" 0)
(graphscr)
;;;
(GETSPACE)
(MAKEONELINELAYER)
;;;
(setq INSPT(getpoint "\nSelect One Line Start Point: "))
;;;
(while
(setq BLK1(entsel "\nSelect A Block: "))
(if BLK1
(progn
(setq BLKENT(entget (car BLK1)))
(if (= (cdr (assoc 0 BLKENT)) "INSERT")
(progn
(setq BLK2(cdr (assoc 2 BLKENT)))
(command ".insert" BLK2 INSPT DIMSC DIMSC 0)
(setq INSPT(list (+ (car INSPT) (* DIMSC 0.75)) (- (cadr INSPT) 0.0)))
)
(princ "\nNot A Block... Please Select Again: ")
)
)
(princ "\nNothing Selected... Please Select Again: ")
)
)
;;;
(command ".undo" "end")
(RESET)
(princ)
)
;;;
;;;;;;;;;;Sub Functions
;;;
(defun GETSPACE (/)
(if (and (equal (getvar "TILEMODE") 0)
(equal (getvar "CVPORT") 1)
)
(setq CSPACE 1);paper space
(setq CSPACE 0);model space.
)
(if (= CSPACE 1)
(setq DIMSC 1.0)
(setq DIMSC(getvar "DIMSCALE"))
)
)
;;;
(defun MAKEONELINELAYER (/)
(setq LAY "FA-ANNO-ONELINE")
;;;
(if (not (tblsearch "layer" LAY))
(command ".-layer" "thaw" LAY "on" LAY "unlock" LAY "make" LAY "color" "1" LAY "lt" "continuous" LAY "")
(progn
(princ (strcat "\nLayer " LAY " Already Exists... Layer Un-Changed... "))
(setvar "clayer" LAY)
)
)
)

[Dlanor]

Make these additions

This needs to go above/below/within the lisp file.

Code - Auto/Visual Lisp: [Select]

1. (vl-load-com)

This gets the block name of any block

Code - Auto/Visual Lisp: [Select]

1. (setq blk_name (vlax-get-property (vlax-ename->vla-object selected_entity) (if (vlax-property-available-p 'effectivename) 'effectivename 'name)))

selected_entity = (car (entsel)) so from your code (car BLK1).

Hope that all makes sense.

[tfpacad19]

Dlanor,

Thanks for the response and I apologize for the delayed reply.

Unfortunately I am, and always have been, a hack when it comes to coding. Consequently I do not know how to add the code to the routine. I understand the vl-load-com part.

Thanks for the assistance