Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/22/2021 in all areas

  1. (defun C:LENGHTPOL (/ ) (setq pol (ssget "_+.:E:S" '((0 . "LWPOLYLINE,POLYLINE")))) (if (not pol) (vl-exit-with-error "") ) (setq Ptx (getpoint "\nSelect text point: ") stringtx (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object (ssname pol 0)))) ">%).Length \\f \"%lu2%pr2\">%" ) vltx (entmakex (list (cons 0 "TEXT") (cons 7 (getvar "TEXTSTYLE")) (cons 10 Ptx) (cons 1 stringtx) (cons 40 2) ) ) ) (vl-cmdf "_updatefield" vltx "") (princ) )
    2 points
  2. I have already noticed, everything is different when it comes to the fields, I will study this routine to learn more, I thank you very much for your attention and for sharing your knowledge.
    1 point
  3. I'm glad I could solve a problem for you! As for the extra data, I'll have to check it out. There will be new conditions that I didn't anticipate, maybe different strings. I'll take a look as soon as I have a moment.
    1 point
  4. You mention a Access database that is good as its like excel in that it has rows and columns. If you google Autocad MS-Access it should go to a Autodesk site with help about how to do. Go to the Jim Claypool post https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autocad-gt-ms-access/td-p/787716
    1 point
  5. (defun C:MTEXTALI (/ *error* ss listsmallnumber a b data1 data2 data3 data4 data5 P1 P2 pol P1 oTX index loop selez codice data) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))) (progn (princ (strcat "\nError: " msg)) (command-s "_UNDO" "") ) ) ) (setq ss (ssget '((0 . "TEXT")))) (if (and (/= (sslength ss) 3)(/= (sslength ss) 5)) (vl-exit-with-error (alert "Selection not 3 or 5 text!")) ) (setq listsmallnumber (mapcar '(lambda (elem) (list elem (vla-get-Textstring elem))) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ) ) (cond ((= (sslength ss) 3) (foreach elem listsmallnumber (cond ((vl-string-search "P-" (cadr elem)) (setq data1 (cadr elem)) ) ((vl-string-search " mm" (cadr elem)) (setq data2 (cadr elem)) ) ((vl-string-search " m" (cadr elem)) (setq data3 (cadr elem)) ) ) ) ) ((= (sslength ss) 5) (foreach elem listsmallnumber (cond ((vl-string-search "P-" (cadr elem)) (setq data1 (cadr elem)) ) ((or (vl-string-search "ROAD" (cadr elem)) (vl-string-search "BO" (cadr elem))) (setq data2 (cadr elem)) ) ((vl-string-search "Ø" (cadr elem)) (setq data3 (cadr elem)) ) ((vl-string-search "m" (cadr elem)) (setq data4 (cadr elem)) ) ((vl-string-search "L/s" (cadr elem)) (setq data5 (cadr elem)) ) ) ) ) ) (cond ((= (sslength ss) 3) (if (not (and data1 data2 data3)) (vl-exit-with-error (alert "Data missing!")) ) ) ((= (sslength ss) 5) (if (not (and data1 data2 data3 data4 data5)) (vl-exit-with-error (alert "Data missing!")) ) ) ) (setq pol (vlax-ename->vla-object (car (entsel "\nSelect pipe polyline: "))) P1 (getpoint "\nSelection position mtext: ") oTX (vla-AddMText (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point P1) 90 (strcat data1 "\\P" data2 "," data3)) ) (cond ((= (sslength ss) 3) (vla-put-TextString oTX (strcat data1 "\\P" data2 "," data3)) ) ((= (sslength ss) 5) (vla-put-TextString oTX (strcat data1 "," data2 "\\P" data3 "," data4 "\\P" data5)) ) ) (vla-put-LineSpacingStyle oTX 2) (vla-put-LineSpacingFactor oTX 0.8) (vla-put-AttachmentPoint oTX 2) (vla-put-Height oTX 7) (vla-put-StyleName oTX "Standard") (vla-put-Rotation oTX (vla-get-Rotation (vlax-ename->vla-object (ssname ss 0)))) (if (= (sslength ss) 3) (progn (if (not (tblsearch "LAYER" (strcat "PIPE" (substr data2 1 (- (strlen data2) 3))))) (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (strcat "PIPE" (substr data2 1 (- (strlen data2) 3)))) ) (vla-put-layer oTX (strcat "PIPE" (substr data2 1 (- (strlen data2) 3)))) ) ) (repeat (setq index (sslength ss)) (entdel (ssname ss (setq index (1- index))))) (setq loop "loop") (while loop (progn (setq selez (grread T 15 0) codice (car selez) data (cadr selez) ) (cond ((= 5 codice) (vla-put-InsertionPoint oTX (vlax-3d-point data)) (if (and (> (vla-get-Rotation oTX) (/ pi 2)) (< (vla-get-Rotation oTX) (* (/ pi 2) 3))) (vla-put-Rotation oTX (- (angle data (vlax-curve-getClosestPointTo pol data)) (/ pi 2))) (vla-put-Rotation oTX (+ (angle data (vlax-curve-getClosestPointTo pol data)) (/ pi 2))) ) ) ((= 3 codice) (vla-put-InsertionPoint oTX (vlax-3d-point data)) (setq loop nil) ) (T (setq loop nil) ) ) ) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) I have noticed that there is not always a mleader, sometimes it is just the text above the polyline. I had fun creating the program that inserts the texts and not the mleaders. Once the small texts are selected, the polyline is selected and the text is inserted dynamically, following the curves of the polyline.
    1 point
  6. (defun C:MLEA (/ *error* ss listsmallnumber data1 data2 data3 data4 data5 P1 P2 points oML index) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))) (progn (princ (strcat "\nError: " msg)) (command-s "_UNDO" "") ) ) ) (setq ss (ssget '((0 . "TEXT")))) (if (and (/= (sslength ss) 3)(/= (sslength ss) 5)) (vl-exit-with-error (alert "Selection not 3 or 5 text!")) ) (setq listsmallnumber (mapcar '(lambda (elem) (list elem (vla-get-Textstring elem))) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ) ) (cond ((= (sslength ss) 3) (foreach elem listsmallnumber (cond ((vl-string-search "P-" (cadr elem)) (setq data1 (cadr elem)) ) ((vl-string-search " mm" (cadr elem)) (setq data2 (cadr elem)) ) ((vl-string-search " m" (cadr elem)) (setq data3 (cadr elem)) ) ) ) ) ((= (sslength ss) 5) (foreach elem listsmallnumber (cond ((vl-string-search "P-" (cadr elem)) (setq data1 (cadr elem)) ) ((or (vl-string-search "ROAD" (cadr elem)) (vl-string-search "BO" (cadr elem))) (setq data2 (cadr elem)) ) ((vl-string-search "Ø" (cadr elem)) (setq data3 (cadr elem)) ) ((vl-string-search "m" (cadr elem)) (setq data4 (cadr elem)) ) ((vl-string-search "L/s" (cadr elem)) (setq data5 (cadr elem)) ) ) ) ) ) (cond ((= (sslength ss) 3) (if (not (and data1 data2 data3)) (vl-exit-with-error (alert "Data missing!")) ) ) ((= (sslength ss) 5) (if (not (and data1 data2 data3 data4 data5)) (vl-exit-with-error (alert "Data missing!")) ) ) ) (setq P1 (getpoint "\nSelection first point MLeader: ") P2 (getpoint "\nSelection second point MLeader: " P1) points (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 5)) (apply 'append (list P1 P2)))) oML (vla-AddMLeader (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) points 0) ) (cond ((= (sslength ss) 3) (vla-put-TextString oML (strcat data1 "\\P" data2 "," data3)) ) ((= (sslength ss) 5) (vla-put-TextString oML (strcat data1 "," data2 "\\P" data3 "," data4 "\\P" data5)) ) ) (if (< (car P2)(car P1)) (vla-setdoglegdirection oML (vla-getleaderindex oML 0) (vlax-3d-point (list -1.0 0.0 0.0))) (vla-setdoglegdirection oML (vla-getleaderindex oML 0) (vlax-3d-point (list 1.0 0.0 0.0))) ) (vla-put-TextLineSpacingStyle oML 2) (vla-put-TextLineSpacingFactor oML 0.8) (vla-put-TextleftAttachmentType oML 7) (vla-put-TextRightAttachmentType oML 7) (vla-put-ArrowheadSize oML 10) (vla-put-TextHeight oML 7) (vla-put-TextJustify oML 2) (vla-put-TextStyleName oML "Standard") (vla-put-DogLegLength oML 3.00) (if (= (sslength ss) 3) (progn (if (not (tblsearch "LAYER" (strcat "PIPE" (substr data2 1 (- (strlen data2) 3))))) (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (strcat "PIPE" (substr data2 1 (- (strlen data2) 3)))) ) (vla-put-layer oML (strcat "PIPE" (substr data2 1 (- (strlen data2) 3)))) ) ) (repeat (setq index (sslength ss)) (entdel (ssname ss (setq index (1- index))))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) There, that should do it. The mleader is placed on the "PIPExxx" layer, where xxx is the diameter of the pipe. If the layer does not exist, it is created, taking the diameter data.
    1 point
  7. (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.
    1 point
×
×
  • Create New...