Hello every one kindly I've a question I've made a code to get the coordinate of the nested blocks and make a point in the nested coordinate it already gets the nested blocks coordinates but also it makes additional points in wrong coordinates kindly see the DWG and the lisp code.. (defun c:GETH20 ( / ss i ent pts ) (vl-load-com) (if (setq ss (ssget '((0 . "INSERT")))) (progn (setq pts '()) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i)))) (setq pts (append pts (FW:FindNestedBlock ent "H20 SECTION" '((1 0 0) (0 1 0) (0 0 1)) ; Identity matrix '(0 0 0) ; Base offset ) ) ) ) ;; Draw points + print coordinates (foreach p pts (entmakex (list '(0 . "POINT") (cons 10 p))) (prompt (strcat "\nH20 at: " (rtos (car p) 2 2) ", " (rtos (cadr p) 2 2) ", " (rtos (caddr p) 2 2) ) ) ) ) ) (princ) ) ;;; ============================================================ ;;; Recursive search for nested block ;;; ============================================================ (defun FW:FindNestedBlock (ent target mat off / enx blk rg newMat newOff blkdef res) (setq enx (entget ent) blk (cdr (assoc 2 enx)) rg (FW:RefGeom ent) newMat (FW:MatMul mat (car rg)) newOff (mapcar '+ (FW:MatVec mat (cadr rg)) off) res '() ) ;; Target block found → real WCS point (if (= (strcase blk) (strcase target)) (setq res (list newOff)) ) ;; Go inside block definition (if (setq blkdef (tblobjname "BLOCK" blk)) (while (setq blkdef (entnext blkdef)) (if (= "INSERT" (cdr (assoc 0 (entget blkdef)))) (setq res (append res (FW:FindNestedBlock blkdef target newMat newOff) ) ) ) ) ) res ) ;;; ============================================================ ;;; RefGeom - rotation, scale, insertion point ;;; ============================================================ (defun FW:RefGeom (ent / enx ang sx sy sz ocs mat ip) (setq enx (entget ent) ang (cdr (assoc 50 enx)) sx (cdr (assoc 41 enx)) sy (cdr (assoc 42 enx)) sz (cdr (assoc 43 enx)) ocs (cdr (assoc 210 enx)) ) ;; Rotation + scale matrix (setq mat (FW:MatMul (list (list (cos ang) (- (sin ang)) 0) (list (sin ang) (cos ang) 0) '(0 0 1) ) (list (list sx 0 0) (list 0 sy 0) (list 0 0 sz) ) ) ) ;; Insertion point in WCS (setq ip (trans (cdr (assoc 10 enx)) ocs 0) ) (list mat ip) ) ;;; ============================================================ ;;; Matrix helpers ;;; ============================================================ (defun FW:MatVec (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m ) ) (defun FW:MatMul (a b) (mapcar '(lambda (r) (mapcar '(lambda (c) (apply '+ (mapcar '* r c))) (apply 'mapcar (cons 'list b)) ) ) a ) ) (princ)

Minor setback on this Swap and rotate program can't seem to get the proper coord's for insertion point of my text. I'm sure it's group code 10, my text is justified at MC. (defun C:SR (/ eset en1 enlist1 en1coord en2 enlist2 en2coord inspt txt1 txt2) (setq oldosnap (getvar "OSMODE")) (setvar "OSMODE" 0) (command "OSNAP" "NONE") (princ "\n ") (princ "\nSelect your two text entities: ") (setq eset (ssget)) (if (and (/= eset nil)(= (sslength eset) 2)) (progn (setq en1(ssname eset 0)) (setq enlist1(entget en1)) (setq en1coord (cdr (assoc 10 enlist1))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq en2(ssname eset 1)) (setq enlist2(entget en2)) (setq en2coord (cdr (assoc 10 enlist2))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq inspt (polar en1coord (angle en1coord en2coord) (/ (distance en1coord en2coord) 2))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq txt1(cdr (assoc 1 enlist1))) (setq txt2(cdr (assoc 1 enlist2))) (setq enlist1 (subst (cons 1 txt2) (assoc 1 enlist1) enlist1)) (entmod enlist1) (setq enlist2 (subst (cons 1 txt1) (assoc 1 enlist2) enlist2)) (entmod enlist2) (entmod eset2) (command "Rotate" "p" "" inspt "180") );progn (princ "\nNothing Selected") );if (setvar "OSMODE" oldosnap) (princ) )

Trying to check for blocks that are not on .25 grid.  Having trouble with wild card.  What am I doing wrong? (defun c:ShowOffGrid (/ blkss idx blkent blkvx blkloc) (setq blkss(ssget "X" '((0 . "INSERT")))) (repeat (setq idx (sslength blkss)) (setq blkent (ssname blkss (setq idx (1- idx))) blkvx (vlax-ename->vla-object blkent) blkloc (vlax-safearray->list (vlax-variant-value(vlax-get-property blkvx 'insertionPoint))) ) (cond ((not(wcmatch (rtos (car blkloc) 2) "*.0, *`.25, *`.5, *`.75" )) (ssdel blkent blkss) ) ((not(wcmatch (rtos (cadr blkloc) 2) "*`.0, *`.25, *`.5, *`.75" )) (ssdel blkent blkss) ) ) ) (sssetfirst nil blkss) (princ) ) (princ "\n----------ShowOffGrid Loaded---------") (princ)

I feel absurd asking, but I can't seem to get this. I need to select one basic block in a layout as part of a LISP. There is one instance of the block in each layout. I've tried many variations of (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "Title Block - To Sheet # anno") (66 . 1))))   (repeat (1+ (sslength ss)) (setq AdjBlk (ssname ss 0))   ) ) or the simpler (setq insert_sset (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "Title Block - To Sheet # anno")))) (setq AdjBlk insert_sset) or the more complicated (if (setq insert_sset (ssget "_X" (list (cons 410 LytLbl) '(0 . "INSERT"))))     (vl-remove-if '(lambda (insert) (/= (strcase "Title Block - To Sheet # anno") (strcase (vla-get-effectivename insert)))) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex insert_sset))))     ) ) but all I get is a nil value for AdjBlk If anyone could point out what's probably obvious, I'd appreciate it. Thanks, Gorra Edited to add: I think I've figured out the problem, the selection is making a selection set, and I've been trying to work with it using list commands.

forgot where did I got this LISP. what the LISP does is you select a solid then it turns the solid into Polyline. can anyone improve the lisp that I will select multiple solids and turn to polyline. Thanks (defun c:Solmulti () (while (setq solids (ssget ":S" '((0 . "SOLID")))) (repeat (sslength solids) (setq solid (ssname solids 0)) (setq pt1 (cdr (assoc 10 (entget solid))) pt2 (cdr (assoc 11 (entget solid))) pt3 (cdr (assoc 12 (entget solid))) pt4 (cdr (assoc 13 (entget solid))) ) (command "_.PLINE" pt1 pt2 pt4 pt3 "C") (command ".erase" solid "") ) ) (princ) )

WHY CAN'T MY LSP FIND THE RESPECTIVE MTEXT, WHICH HAS THE INPUT, A BREAK AND IN THE SEQUENCE THE VALUE. IT CANNOT ORGANIZE THE LIST, ADD THE ITEMS BY THE INPUT AND ADD THE VALUE (defun TOTAL (/ ss ent i txt valor texto QA QB QC QD) (setq A 0.0 B 0.0 C 0.0 D 0.0 ) (setq ss (ssget "_X" '((0 . "MTEXT")))) (if ss (progn (setq i 0) (while (< i (sslength ss)) (setq ent (ssname ss i)) (setq txt (cdr (assoc 1 (entget ent)))) (if valor (cond ((wcmatch txt "*A*") (setq QA (+ QA valor))) ((wcmatch txt "*B*") (setq QB (+ QB valor))) ((wcmatch txt "*C*") (setq QC (+ QC valor))) ((wcmatch txt "*D*") (setq QD (+ QD valor))) ) ) ) (setq texto (strcat "\n TOTAL TEXT\n\n" "SUM TEXT A → " (rtos QA 2 2) " \n" "SUM TEXT B → " (rtos QB 2 2) " \n" "SUM TEXT C → " (rtos QC 2 2) " \n" "SUM TEXT D → " (rtos QD2 2) " \n" ) ) (princ texto) ) (princ "\nNo MTEXT found in drawing.") ) (princ) )

(defun c:p2h (/ _addhatch _boundary b spc s) (defun _addhatch (spc bnd lyr / h) (if (setq h (vlax-invoke spc 'addhatch achatchobject "Solid" :vlax-true)) (progn (vlax-invoke h 'appendouterloop (list bnd)) (vla-put-layer h lyr) (vla-evaluate h) (vla-update h) h ) ) ) (defun _boundary (p / e) (setq e (entlast)) (bpoly p) (if (not (equal e (entlast))) (entlast) ) ) (cond ((setq s (ssget '((0 . "POINT")))) (setq spc (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0)))))) (setvar 'cmdecho 0) (command "_.undo" "_begin") (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (if (setq b (_boundary (cdr (assoc 10 (entget e))))) (progn (_addhatch spc (vlax-ename->vla-object b) (cdr (assoc 8 (entget e)))) (entdel b)) ) ) (command "_.undo" "_end") (setvar 'cmdecho 1) ) ) (princ) )

Hi, I would be very grateful if anyone can help me with a lisp that disconnects all the structures from their pipes in one time in the drawing I have this thing but it does not work Thanks in advance (defun c:DISCONNECTSTRUCTURES (/ ss i ent) ;; Try to select all pipe structure objects (command "._SELECTSIMILAR" "SI" "ALL") (setq ss (ssget "P" '((0 . "AeccDbPipeStructure")))) (if ss (progn (setq i 0) (repeat (sslength ss) (setq ent (ssname ss i)) ;; Use the Civil 3D command to disconnect the structure (command "._AeccStructureDisconnect" ent "") (setq i (1+ i)) ) (princ (strcat "\nDisconnected " (itoa (sslength ss)) " structures.")) ) (princ "\nNo pipe structures found in drawing.") ) (princ) )

Need help to fic the code, Just insert "D_ARW" Block in each Mline midle. (defun c:IN_ARW (/ mline-list mline start-point end-point ARW-block mid-point i) (setq mline-list (ssget '((0 . "MLINE")))) (setq ARW-block "D_ARW") ; Block name (if mline-list (progn (setq i 0) (repeat (sslength mline-list) (setq mline (ssname mline-list i)) (setq start-point (vlax-curve-getStartPoint mline)) (setq end-point (vlax-curve-getEndPoint mline)) (setq mid-point (list (/ (+ (car start-point) (car end-point)) 2.0) (/ (+ (cadr start-point) (cadr end-point)) 2.0))) (command "_.INSERT" ARW-block mid-point 1 1 0) ; Insert block with correct rotation (setq i (1+ i)) ; Increment index ) ) ) (princ) )

Experience innovation in maritime technology with the Marintec Innovation Conference 2024, focusing on alternative energy and sustainable practices.

I am working on some git-VSS interop and the way I have approached syncing my git master with SS is git checkout vss_branch ss get . -W -R -Q -Y$SSNAME git checkout master git rebase vss_branch ma...