2D blocks and lines to 3D

July 16, 2021

Found this similar topic from before (https://www.cadtutor.net/forum/topic/55616-2d-to-3d-polyline-by-points/), but I decided to start a new one hopefully someone will help because its more complex thing for my case. Instead selecting points and 2d polylines I have point blocks and lines.

I have a 2D drawing of lines and points that are actually blocks with attributes (height, etc...). I would need a lisp to extract height attribute from each point block that is in layer POINTS, set that value to block z coordinate, and also make 3D lines from 2D lines, same thing like in that thread before (but instead polylines i have lines, if thats a problem I can convert lines to polylines), BUT all lines have to stay in the same layer as they were before.

Here is the code from mentioned thread. I am trying to change it for my needs but no luck so far, any help or advice would be welcome.

(defun c:poly23dpoly ( / enx idx lst pll ptl sel )
   (princ "\nSelect points & 2d polylines: ")
   (if (setq sel (ssget '((0 . "LWPOLYLINE,POINT"))))
       (progn
           (repeat (setq idx (sslength sel))
               (setq enx (entget (ssname sel (setq idx (1- idx)))))
               (if (= "POINT" (cdr (assoc 0 enx)))
                   (setq ptl (cons (cdr (assoc 10 enx)) ptl))
                   (setq pll (cons (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx)) pll))
               )
           )
           (foreach grp pll
               (foreach vtx grp
                   (if (setq vtx (car (vl-member-if '(lambda ( a ) (equal vtx (list (car a) (cadr a)) 1e-4)) ptl)))
                       (setq lst (cons vtx lst))
                   )
               )
               (if (cdr lst)
                   (progn
                       (entmake '((0 . "POLYLINE") (70 . 8)))
                       (foreach vtx lst
                           (entmake
                               (list
                                  '(00 . "VERTEX")
                                  '(70 . 32)
                                   (cons 10 vtx)
                               )
                           )
                       )
                       (entmake '((0 . "SEQEND")))
                   )
               )
               (setq lst nil)
           )
       )
   )
   (princ)
)

Edited July 16, 2021 by lastknownuser

July 16, 2021

It would be good to have a dwg part so we can see...

July 16, 2021

Right, here it is, example of small part, I have a huge area for landscape planning that needs to be redone in 3D. All points are block with height attribute, that I should know how to bring to 3D, but to bring lines and keep them connected to those points is what I can't figure out. Also all symbols that are blocks should be snapped to points in 3D, like the tree here.

I could use the given code from other thread by changing blocks to points and lines to polylines, but it would take me a lot of time so hopefully this can be done in a way I need it, but the part about keeping them in original layer is necessary, that code above creates a new 3D polyline in current layer.

July 16, 2021

No, not the image, but the actual dwg piece, I need to know the names of the blocks and the attribute tag.

July 16, 2021

Oh sorry, here it is, just a basic example so I dont send huge files

test2d.dwg

July 16, 2021

(defun C:CHBLOCK (/ grublocks index ename height entgetename)
 (setq grublocks (ssget (list (cons 0 "INSERT") (cons 2 (strcase "TOCKE")))))
 (repeat (setq index (sslength grublocks))
  (setq ename (ssname grublocks (setq index (1- index))))
  (setq height (cadr (assoc "HEIGHT" 
			   (mapcar
			    '(lambda (j) (list (vla-get-tagstring j) (distof (vla-get-textstring j))))
			    (vlax-invoke (vlax-ename->vla-object ename) 'Getattributes)
			   )
		     )
	       )	     
  )
  (setq entgetename (subst (list 10 (cadr (assoc 10 (entget ename))) (caddr (assoc 10 (entget ename))) height) (assoc 10 (entget ename)) (entget ename)))
  (entmod entgetename)
 )
 (vl-cmdf "_ATTSYNC" "N" "tocke")
 (princ)
)

In the meantime, the lisp program changes the elevation of all blocks. There would be a problem with the synchronisation of the attributes (they overlap the texts from time to time), since those also have to be moved to the block height.

July 16, 2021

(defun C:CHLINE (/ grublocks index ename height entgetename)
 (setq grulineblocks
       (ssget (list (cons -4 "<OR")
		    (cons 0 "LINE")
		    (cons -4 "<AND")
		    (cons 0 "INSERT")
		    (cons 2 (strcase "TOCKE"))
		    (cons -4 "AND>")
		    (cons -4 "OR>")
	      )
       )
       gruline (ssadd)
       grublocks (ssadd)
 )
 
 (repeat (setq index (sslength grulineblocks))
  (setq ename (ssname grulineblocks (setq index (1- index))))

  (cond
   ((= (cdr (assoc 0 (entget ename))) "LINE")
    (ssadd ename gruline)
   ) 
   ((= (cdr (assoc 0 (entget ename))) "INSERT")
    (ssadd ename grublocks)
   )
  )

 )

 (setq gruline (mapcar 'cadr (ssnamex gruline)))
 (setq grublocks (mapcar 'cadr (ssnamex grublocks)))


 (foreach elem gruline
  (foreach elem1 grublocks
   (if (equal (list (car (cdr (assoc 10 (entget elem))))
		    (cadr (cdr (assoc 10 (entget elem))))
	      )
	      (list (car (cdr (assoc 10 (entget elem1))))
		    (cadr (cdr (assoc 10 (entget elem1))))
	      )
	      0.001
       )
    (progn
     (setq b1 (subst (list 10
			   (car (cdr (assoc 10 (entget elem))))
			   (cadr (cdr (assoc 10 (entget elem))))
			   (caddr (cdr (assoc 10 (entget elem1))))
		     )
		     (assoc 10 (entget elem))
		     (entget elem)
	      )
     )
     (entmod b1)
    )
   )
  )
  (foreach elem1 grublocks
   (if (equal (list (car (cdr (assoc 11 (entget elem))))
		    (cadr (cdr (assoc 11 (entget elem))))
	      )
	      (list (car (cdr (assoc 10 (entget elem1))))
		    (cadr (cdr (assoc 10 (entget elem1))))
	      )
	      0.001
       )
    (progn (setq b1 (subst (list 11
				 (car (cdr (assoc 11 (entget elem))))
				 (cadr (cdr (assoc 11 (entget elem))))
				 (caddr (cdr (assoc 10 (entget elem1))))
			   )
			   (assoc 11 (entget elem))
			   (entget elem)
		    )
	   )
	   (entmod b1)
    )
   )
  )
 ) 
 
 (princ)
)

I threw this down in a pretty rough way, first you have to run the CHBLOCK command, then CHLINE. Basically the program searches line by line, which block corresponds to which x and y coordinates. When it has found it, it replaces the z-coordinate with that of the block, which has already been elevated. Give it a try and see if it works. For brevity's sake I didn't use the usual vla-vlax functions, I'll review it when I have a bit more time. For example, I mistakenly used the foreach function also for blocks, so once found the right block the program should stop searching and go to the next block, instead, of course, it continues. If there are few entities it can be fine, but if you start to have mega upon mega of drawing then it slows down noticeably.

Edited July 16, 2021 by confutatis

July 16, 2021

(defun C:CHLINE	(/ grulineblocks gruline grublocks index ename ok)
 (setq grulineblocks
       (ssget (list (cons -4 "<OR")
		    (cons 0 "LINE")
		    (cons -4 "<AND")
		    (cons 0 "INSERT")
		    (cons 2 (strcase "TOCKE"))
		    (cons -4 "AND>")
		    (cons -4 "OR>")
	      )
       )
       gruline (ssadd)
       grublocks (ssadd)
 )

 (repeat (setq index (sslength grulineblocks))
  (setq ename (ssname grulineblocks (setq index (1- index))))

  (cond
   ((= (cdr (assoc 0 (entget ename))) "LINE")
    (ssadd ename gruline)
   )
   ((= (cdr (assoc 0 (entget ename))) "INSERT")
    (ssadd ename grublocks)
   )
  )

 )

 (setq gruline (mapcar 'cadr (ssnamex gruline)))
 (setq grublocks (mapcar 'cadr (ssnamex grublocks)))
 (setq index 0)
 (foreach elem gruline

  (setq ok "OK")
  (while ok
   (if (equal (list (car (cdr (assoc 10 (entget elem))))
		    (cadr (cdr (assoc 10 (entget elem))))
	      )
	      (list (car (cdr (assoc 10 (entget (nth index grublocks)))))
		    (cadr (cdr (assoc 10 (entget (nth index grublocks)))))
	      )
	      0.001
       )
    (progn
     (setq b1 (subst (list 10
			   (car (cdr (assoc 10 (entget elem))))
			   (cadr (cdr (assoc 10 (entget elem))))
			   (caddr (cdr (assoc 10 (entget (nth index grublocks)))))
		     )
		     (assoc 10 (entget elem))
		     (entget elem)
	      )
     )
     (entmod b1)
     (setq grublocks (vl-remove (nth index grublocks) grublocks))
     (setq index 0)
     (setq ok nil)
    )
    (setq index (1+ index))
   )
  )

  (setq ok "OK")
  (while ok
   (if (equal (list (car (cdr (assoc 11 (entget elem))))
		    (cadr (cdr (assoc 11 (entget elem))))
	      )
	      (list (car (cdr (assoc 10 (entget (nth index grublocks)))))
		    (cadr (cdr (assoc 10 (entget (nth index grublocks)))))
	      )
	      0.001
       )
    (progn (setq b1 (subst (list 11
				 (car (cdr (assoc 11 (entget elem))))
				 (cadr (cdr (assoc 11 (entget elem))))
				 (caddr (cdr (assoc 10 (entget (nth index grublocks)))))
			   )
			   (assoc 11 (entget elem))
			   (entget elem)
		    )
	   )
	   (entmod b1)
	   (setq grublocks (vl-remove (nth index grublocks) grublocks))
	   (setq index 0)
	   (setq ok nil)
    )
    (setq index (1+ index))
   )
  )
 )
 (princ)
)

Now is better...

July 16, 2021

Do you need to get X Y ? I may be wrong the simple test worked. Removes a few steps.

(setq pt1 (cons 10 (list 12.34 56.78 99.45)))
(10 12.34 56.78 99.45)

(setq pt2 (cons 10 (list 12.34 56.78 99.45)))
(10 12.34 56.78 99.45)

(equal pt1 pt2 0.00001)
T

(setq pt2 (cons 10 (list 12.44 56.99 99.45)))
(10 12.44 56.99 99.45)
(equal pt1 pt2 0.00001)
nil

July 17, 2021

Bigal, I need yes, to take only x and y, remember that the lines have z=0, blocks no.


(setq pt1 (list 12.34 56.78 99.45))
(12.34 56.78 99.45)

(setq pt2 (list 12.34 56.78 0.00))
(12.34 56.78 0.0)

(equal pt1 pt2 0.00001)
nil 


(setq pt1 (list 12.34 56.78))
(12.34 56.78)

(setq pt2 (list 12.34 56.78))
(12.34 56.78)

(equal pt1 pt2 0.00001)
T

Edited July 17, 2021 by confutatis

July 19, 2021

@confutatisthanks a lot, you have been a huge help! Is there also a way to put all other blocks, symbols, in 3D just like lines, maybe by some 3rd command? I get the problem that they all have different name so its probably not as easy as with points block "TOCKE", but its beyond my lisp understanding how to do so.

July 19, 2021

So, the "TOCKE" block that contains the dimension, from what I have seen, is the block that is the reference for all the other entities. So I would say that you can apply the command, with appropriate variations, to the other entities as well.

July 19, 2021

(defun C:CHEENT	(/ gruent grublockstocke gruotherentity index ename height point ok pointtocke)
 (setq gruent (ssget)
       grublockstocke (ssadd)
       gruotherentity (ssadd)
 )

 (repeat (setq index (sslength gruent))
  (setq ename (ssname gruent (setq index (1- index))))
  (cond
   ((and (= (cdr (assoc 0 (entget ename))) "INSERT")(= (strcase (cdr (assoc 2 (entget ename)))) "TOCKE"))
    (ssadd ename grublockstocke)
   )
   (T
    (ssadd ename gruotherentity)
   )
  )
 )

 (setq grublockstocke (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp  (mapcar 'cadr (ssnamex grublockstocke)))))
 (setq gruotherentity (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp  (mapcar 'cadr (ssnamex gruotherentity)))))

 (foreach elem grublockstocke
  (setq height (cadr (assoc "HEIGHT" 
			   (mapcar
			    '(lambda (elem1) (list (vla-get-tagstring elem1) (distof (vla-get-textstring elem1))))
			    (vlax-invoke elem 'Getattributes)
			   )
		     )
	       )	     
  )
  (setq point (safearray-value (variant-value (vla-get-InsertionPoint elem))))
  (vla-put-InsertionPoint elem (vlax-3d-point (list (car point) (cadr point) height)))
 )
 
 (foreach elem gruotherentity
  (cond
   ((or (= (vla-get-ObjectName elem) "AcDbBlockReference") (= (vla-get-ObjectName elem) "AcDbText"))
    (setq index 0)
    (setq ok "OK")
    (while (and ok (< index (length grublockstocke)) (> (length grublockstocke) 0))
     (setq point (safearray-value (variant-value (vla-get-InsertionPoint elem))))
     (setq pointtocke (safearray-value (variant-value (vla-get-InsertionPoint (nth index grublockstocke)))))
     (if (equal (list (car point) (cadr point)) (list (car pointtocke) (cadr pointtocke)) 0.001)
      (progn
       (vla-put-InsertionPoint elem (vlax-3d-point (list (car point) (cadr point) (caddr pointtocke))))
       (setq grublockstocke (vl-remove (nth index grublockstocke) grublockstocke))
       (setq index 0)
       (setq ok nil)
      )
      (setq index (1+ index))
     ) 
    )
   )
   ((= (vla-get-ObjectName elem) "AcDbLine")
    (setq index 0)
    (setq ok "OK")
    (while (and ok (< index (length grublockstocke)) (> (length grublockstocke) 0))
     (setq point (safearray-value (variant-value (vla-get-StartPoint elem))))
     (setq pointtocke (safearray-value (variant-value (vla-get-InsertionPoint (nth index grublockstocke)))))
     (if (equal (list (car point) (cadr point)) (list (car pointtocke) (cadr pointtocke)) 0.001)
      (progn
       (vla-put-Startpoint elem (vlax-3d-point (list (car point) (cadr point) (caddr pointtocke))))
       (setq grublockstocke (vl-remove (nth index grublockstocke) grublockstocke))
       (setq index 0)
       (setq ok nil)
      )
      (setq index (1+ index))
     ) 
    )
    (setq index 0)
    (setq ok "OK")
    (while (and ok (< index (length grublockstocke)) (> (length grublockstocke) 0))
     (setq point (safearray-value (variant-value (vla-get-EndPoint elem))))
     (setq pointtocke (safearray-value (variant-value (vla-get-InsertionPoint (nth index grublockstocke)))))
     (if (equal (list (car point) (cadr point)) (list (car pointtocke) (cadr pointtocke)) 0.001)
      (progn
       (vla-put-Endpoint elem (vlax-3d-point (list (car point) (cadr point) (caddr pointtocke))))
       (setq grublockstocke (vl-remove (nth index grublockstocke) grublockstocke))
       (setq index 0)
       (setq ok nil)
      )
      (setq index (1+ index))
     ) 
    )
   )
  )
 )
 
 (princ)
)

;;;This list cancels and replaces the previous ones!!

It should be OK, the CHEENT command puts the TOCKE blocks at the right height and with this reference fixes all the selected entities. For now, blocks, text and lines are included, but the selection can be extended later.

Edited July 20, 2021 by confutatis

July 22, 2021

On 19/07/2021 at 14:32, confutatis said:


(defun C:CHEENT	(/ gruent grublockstocke gruotherentity index ename height point ok pointtocke)
 (setq gruent (ssget)
       grublockstocke (ssadd)
       gruotherentity (ssadd)
 )

 (repeat (setq index (sslength gruent))
  (setq ename (ssname gruent (setq index (1- index))))
  (cond
   ((and (= (cdr (assoc 0 (entget ename))) "INSERT")(= (strcase (cdr (assoc 2 (entget ename)))) "TOCKE"))
    (ssadd ename grublockstocke)
   )
   (T
    (ssadd ename gruotherentity)
   )
  )
 )

 (setq grublockstocke (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp  (mapcar 'cadr (ssnamex grublockstocke)))))
 (setq gruotherentity (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp  (mapcar 'cadr (ssnamex gruotherentity)))))

 (foreach elem grublockstocke
  (setq height (cadr (assoc "HEIGHT" 
			   (mapcar
			    '(lambda (elem1) (list (vla-get-tagstring elem1) (distof (vla-get-textstring elem1))))
			    (vlax-invoke elem 'Getattributes)
			   )
		     )
	       )	     
  )
  (setq point (safearray-value (variant-value (vla-get-InsertionPoint elem))))
  (vla-put-InsertionPoint elem (vlax-3d-point (list (car point) (cadr point) height)))
 )
 
 (foreach elem gruotherentity
  (cond
   ((or (= (vla-get-ObjectName elem) "AcDbBlockReference") (= (vla-get-ObjectName elem) "AcDbText"))
    (setq index 0)
    (setq ok "OK")
    (while (and ok (< index (length grublockstocke)) (> (length grublockstocke) 0))
     (setq point (safearray-value (variant-value (vla-get-InsertionPoint elem))))
     (setq pointtocke (safearray-value (variant-value (vla-get-InsertionPoint (nth index grublockstocke)))))
     (if (equal (list (car point) (cadr point)) (list (car pointtocke) (cadr pointtocke)) 0.001)
      (progn
       (vla-put-InsertionPoint elem (vlax-3d-point (list (car point) (cadr point) (caddr pointtocke))))
       (setq grublockstocke (vl-remove (nth index grublockstocke) grublockstocke))
       (setq index 0)
       (setq ok nil)
      )
      (setq index (1+ index))
     ) 
    )
   )
   ((= (vla-get-ObjectName elem) "AcDbLine")
    (setq index 0)
    (setq ok "OK")
    (while (and ok (< index (length grublockstocke)) (> (length grublockstocke) 0))
     (setq point (safearray-value (variant-value (vla-get-StartPoint elem))))
     (setq pointtocke (safearray-value (variant-value (vla-get-InsertionPoint (nth index grublockstocke)))))
     (if (equal (list (car point) (cadr point)) (list (car pointtocke) (cadr pointtocke)) 0.001)
      (progn
       (vla-put-Startpoint elem (vlax-3d-point (list (car point) (cadr point) (caddr pointtocke))))
       (setq grublockstocke (vl-remove (nth index grublockstocke) grublockstocke))
       (setq index 0)
       (setq ok nil)
      )
      (setq index (1+ index))
     ) 
    )
    (setq index 0)
    (setq ok "OK")
    (while (and ok (< index (length grublockstocke)) (> (length grublockstocke) 0))
     (setq point (safearray-value (variant-value (vla-get-EndPoint elem))))
     (setq pointtocke (safearray-value (variant-value (vla-get-InsertionPoint (nth index grublockstocke)))))
     (if (equal (list (car point) (cadr point)) (list (car pointtocke) (cadr pointtocke)) 0.001)
      (progn
       (vla-put-Endpoint elem (vlax-3d-point (list (car point) (cadr point) (caddr pointtocke))))
       (setq grublockstocke (vl-remove (nth index grublockstocke) grublockstocke))
       (setq index 0)
       (setq ok nil)
      )
      (setq index (1+ index))
     ) 
    )
   )
  )
 )
 
 (princ)
)

;;;This list cancels and replaces the previous ones!!

It should be OK, the CHEENT command puts the TOCKE blocks at the right height and with this reference fixes all the selected entities. For now, blocks, text and lines are included, but the selection can be extended later.

Exactly what I needed, thanks a lot!

2D blocks and lines to 3D

Recommended Posts

lastknownuser

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

lastknownuser

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

lastknownuser

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

lastknownuser

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

confutatis

Link to comment

Share on other sites

lastknownuser

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity