Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/01/2025 in Posts

  1. If all the primitives (TEXT,MTEXT,INSERT,LINE,LWP,Circle,Mleader,Dimension) are perceived as objects, then you can use this code: ;; Set coordinates of objects (TEXT,MTEXT,INSERT,LINE,LWP,Circle,Mleader,Dimension) Z in 0 (defun zeroz-in-list (lst /) (cond ;; The list of coordinates-vertex ((and (listp lst) (= (length lst) 2) (numberp (car lst)) (numberp (cadr lst))) ;; if only XY - expanding to XYZ (list (car lst) (cadr lst) 0.0) ) ((and (listp lst) (= (length lst) 3) (numberp (car lst)) (numberp (cadr lst)) (numberp (caddr lst))) ;; if already XYZ - just do Z=0.0 (list (car lst) (cadr lst) 0.0) ) ;; If it's a large list, it's probably nested ((listp lst) (mapcar 'zeroz-in-list lst) ) (t lst) ) ) (defun c:ObjZ0 (/ ss n e el newel) (prompt " Select objects (all types, including polylines, mleader, dimension): ") (if (setq ss (ssget)) (progn (setq n 0) (while (< n (sslength ss)) (setq e (ssname ss n) el (entget e) newel nil ) (foreach pair el (cond ;; height LWPOLYLINE (code 38) ((and (= (car pair) 38) (numberp (cdr pair))) (setq newel (cons (cons 38 0.0) newel)) ) ;;Point codes (for example, 10, 11, 12...), etc. ((and (numberp (car pair)) (not (= (car pair) 210))) ; Don't touch the normal (if (listp (cdr pair)) (setq newel (cons (cons (car pair) (zeroz-in-list (cdr pair))) newel)) (setq newel (cons pair newel)) ) ) ;; The rest (t (setq newel (cons pair newel))) ) ) ;; Restoring order and modifying the object (entmod (reverse newel)) (setq n (1+ n)) ) ) ) (princ) ) If the Z coordinate is not displayed in the properties (example, for dimensions, for Mleader), then you need to use the _LIST command. Don't think of me as a programmer... The code is written using AI.
    1 point
  2. There was a thread a few days ago about speeding up a LISP to do the same, have look at that for ideas. I think the thread got as far as arcs are tricky to do with LISPs. You could use the flatten command for small drawings. This snippet will filter a selection set to lines or LWPolylines to anything not 0 Z (setq MySS (ssget (list (cons 0 "*TEXT,INSERT,LINE,LWPOLYLINE") '(-4 . "<OR") '(-4 . "*,*,<>") (list 10 0.0 0.0 0.0) '(-4 . "*,*,<>") (list 11 0.0 0.0 0.0) '(-4 . "<>") (cons 38 0) '(-4 . "OR>") )) ; end list, end ssget ) Can be added to the other solutions herein the case that your drawing has a lot of lines / polylines / blocks it speeds it up a bit Link to other thread:
    1 point
  3. Try an another version (vl-load-com) (defun c:BLOCKINSERT ( / ss blkname acadObj doc mspace n dxf_ent vlaobj pr nb_e scl_blk pt lst_pt nbs ang1 ang2 blk lst itm) (setq ss (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>"))) blkname "Stalb" ) (cond ((and ss (tblsearch "BLOCK" blkname)) (setq acadObj (vlax-get-acad-object) doc (vla-get-activedocument acadObj) mspace (vla-get-modelspace doc) ) (if (null (tblsearch "LAYER" "EL_стълб_НН")) (vlax-put (vla-add (vla-get-layers doc) "EL_стълб_НН") 'color 1) ) (repeat (setq n (sslength ss)) (setq dxf_ent (entget (setq ent (ssname ss (setq n (1- n))))) dxf_210 (cdr (assoc 210 dxf_ent)) lst_pt nil) (setq vlaobj (vlax-ename->vla-object ent) pr -1 ) (repeat (setq nb_e (if (zerop (vlax-get vlaobj 'Closed)) (1+ (fix (vlax-curve-getEndParam vlaobj))) (fix (vlax-curve-getEndParam vlaobj)))) (if (not scl_blk) (progn (initget 6) (setq scl_blk (getreal "\nBlock scale?<1>: ")))) (if (not scl_blk) (setq scl_blk 1.0)) (setq pt (vlax-curve-GetPointAtParam vlaobj (setq pr (1+ pr))) lst_pt (cons pt lst_pt) ) (setq nbs (1- (length lst_pt))) ) (foreach pto lst_pt (if (and (not (zerop nbs)) (not (eq (1+ nbs) (length lst_pt)))) (setq ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ang2 (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (1- nbs)))) ) (setq ang1 (if (not (zerop nbs)) (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (1- nbs)))) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ) ang2 ang1 ) ) (if (and (zerop nbs) (not (zerop (vlax-get vlaobj 'Closed)))) (setq ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ang2 (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (length lst_pt)))) ) ) (if (and (eq (1+ nbs) (length lst_pt)) (not (zerop (vlax-get vlaobj 'Closed)))) (setq ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ) ) (setq nbs (1- nbs) blk (vla-InsertBlock mspace (vlax-3d-point pto) blkname scl_blk scl_blk scl_blk 0.0) ) (vlax-put blk 'Layer "EL_стълб_НН") (vlax-put blk 'Color 3) (setq lst (list (cons "Angel_1" ang1) (cons "Angel_2" ang2))) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (vla-get-propertyname x) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) ) ) ) (prin1) )
    1 point
  4. Hi @p7q, You can try with this several options from image below. From the last lines of code, you will get something like this. Try to play with this. Also, you can get from Lee Mac website about Attribute Functions. Best regards.
    1 point
×
×
  • Create New...