Engineer_Yasser Posted April 1, 2023 Posted April 1, 2023 Hello Everyone, I made this lisp using google and I tested it's working >>> but stop suddenly not continuing the loop I made a lot of searches but found nothing to fix my issue This Lisp selects only Polylines with ARC segment and puts ARC Dimension I have another Lisp to make dimensions to normal polyline and I will combine it ... can you help to fix the issue in this lisp, please if you can make a favour and make a lisp to dimension all polylines ( normal & curved ) , you will save me from losing a lot of time. Thanks (defun c:test () (defun *error* (msg) (if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) (vl-load-com) (if (setq sel (ssget '((-4 . "<AND") (0 . "*POLYLINE")(-4 . "<>") (42 . 0.0) (-4 . "AND>")))) (progn (setq i 0) (while (< i (sslength sel)) (setq MyEnt (ssname sel i)) (setq mid (vlax-curve-getPointAtDist MyEnt (/ (vlax-curve-getDistAtPoint MyEnt (vlax-curve-getEndPoint MyEnt)) 2.0))) (command "_.DIMARC" MyEnt mid mid) (setq i (+ i 1)) ) ) ) (princ) ) Lisp.lsp Test DWG.dwg Quote
rlx Posted April 1, 2023 Posted April 1, 2023 haven't tested your routine but my first guess would be to declare / localize all your variables 1 Quote
Tsuky Posted April 1, 2023 Posted April 1, 2023 In the place of: (command "_.DIMARC" MyEnt mid mid) Try this instead: (command "_.DIMARC" "_none" mid "_none" mid) Quote
Engineer_Yasser Posted April 2, 2023 Author Posted April 2, 2023 6 hours ago, Tsuky said: In the place of: (command "_.DIMARC" MyEnt mid mid) Try this instead: (command "_.DIMARC" "_none" mid "_none" mid) Same Issue even after using (command "_.DIMARC" MyEnt "_none" mid "_none" mid) Quote
Steven P Posted April 2, 2023 Posted April 2, 2023 With testing you might put in a few 'princ' statements to let the LISP report what it is doing, for example: .... (if (setq sel (ssget '((-4 . "<AND") (0 . "*POLYLINE")(-4 . "<>") (42 . 0.0) (-4 . "AND>")))) (progn (princ "\nSel Length:")(princ (sslength sel)) (setq i 0) (while (< i (sslength sel)) (princ "\nCount: ")(princ i) (setq MyEnt (ssname sel i)) (princ "\nMyEnt: ")(princ MyEnt) (setq mid (vlax-curve-getPointAtDist MyEnt (/ (vlax-curve-getDistAtPoint MyEnt (vlax-curve-getEndPoint MyEnt)) 2.0))) (princ "\nMid: ")(princ mid) (command "_.DIMARC" MyEnt mid mid) (setq i (+ i 1)) ) ) ) .... Quote
Tsuky Posted April 2, 2023 Posted April 2, 2023 5 hours ago, Engineer_Yasser said: Same Issue even after using (command "_.DIMARC" MyEnt "_none" mid "_none" mid) You did not read me well !... (command "_.DIMARC" MyEnt "_none" mid "_none" mid) DIMARC requires a selection by point and not a selection by entity name. 1 Quote
Engineer_Yasser Posted April 2, 2023 Author Posted April 2, 2023 1 hour ago, Tsuky said: You did not read me well !... (command "_.DIMARC" MyEnt "_none" mid "_none" mid) DIMARC requires a selection by point and not a selection by entity name. Thanks for the assistance, you are right .. it works without an entity name But still, The Lisp Stops randomly ... I will attach the complete lisp file to check Dimension PL &Cur.LSP Test DWG.dwg Quote
Tsuky Posted April 2, 2023 Posted April 2, 2023 6 hours ago, Engineer_Yasser said: Thanks for the assistance, you are right .. it works without an entity name But still, The Lisp Stops randomly ... I will attach the complete lisp file to check Dimension PL &Cur.LSPUnavailable Test DWG.dwgUnavailable In some cases, because it requires a selection point, depending on the zoom it may fail. The solution: make an object zoom in the loop. I present to you my solution with dimension But if the dimension is not necessary, I propose another solution to you which will be much faster, the zoom not being useful any more. (vl-load-com) (defun c:Dim_PolyArc ( / js AcDoc n ename obj pr pt_sel seg_bulge deriv alpha pt_dim) (princ "\nSelect polylines.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSelection is empty, or aren't POLYLINES!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndoMark AcDoc) (setvar "CMDECHO" 0) (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ename) pr -0.5 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq pt_sel (vlax-curve-GetPointAtParam obj (setq pr (1+ pr))) seg_bulge (vla-GetBulge obj (- pr 0.5)) deriv (vlax-curve-getFirstDeriv obj pr) alpha (- (atan (cadr deriv) (car deriv)) (* pi 0.5)) pt_dim (polar pt_sel alpha (* 2.0 (getvar "DIMTXT"))) ) (command "_.zoom" "_object" ename "") (if (not (zerop seg_bulge)) (command "_.dimarc" "_none" (trans pt_sel 0 1) "_none" (trans pt_sel 0 1)) (command "_.dimaligned" "_none" (trans (vlax-curve-GetPointAtParam obj (- pr 0.5)) 0 1) "_none" (trans (vlax-curve-GetPointAtParam obj (+ pr 0.5)) 0 1) "_none" (trans pt_sel 0 1) ) ) (command "_.zoom" "_previous") ) ) (setvar "CMDECHO" 1) (vla-EndUndoMark AcDoc) (prin1) ) (vl-load-com) (defun c:label_dist-vertex_po ( / js htx AcDoc Space nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha nw_obj) (princ "\nSelect polylines.") (while (null (setq js (ssget '( (0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") ) ) ) ) (princ "\nSelection is empty, or aren't POLYLINES!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify height text <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Label-vertex-poly")) (vlax-put (vla-add (vla-get-layers AcDoc) "Label-vertex-poly") 'color 7) ) ) (cond ((null (tblsearch "STYLE" "Length-vertex")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Length-vertex")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\Romantic.ttf") 0.0 0.0 1.0 0.0) ) ) ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 ) (repeat (fix (vlax-curve-getEndParam ename)) (setq dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr))) dist_end (vlax-curve-GetDistAtParam ename (1+ pr)) pt_start (vlax-curve-GetPointAtParam ename pr) pt_end (vlax-curve-GetPointAtParam ename (1+ pr)) seg_len (- dist_end dist_start) alpha (angle (trans pt_start 0 1) (trans pt_end 0 1)) ) (if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (vlax-curve-GetPointAtParam ename (+ 0.5 pr)))) 0.0 (rtos seg_len 2 2) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Length-vertex" "Label-vertex-poly" alpha) ) ;(vla-put-BackgroundFill nw_obj -1) ) ) (prin1) ) Quote
mhupp Posted April 2, 2023 Posted April 2, 2023 (edited) @Engineer_Yasser updated your code to work with polylines longer then one segment. Then I noticed depending on the zoom some dims might not be created. particularity the 7.40 and 14.52 . updating to visual lisp and not using command fixes this issue and should make it run faster. (defun c:test (/ sel myent bulg i p1 p2 mid a r c) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq mspace (vla-get-ModelSpace doc)) ;forgot this line (if (setq sel (ssget '((-4 . "<AND") (0 . "*POLYLINE") (-4 . "<>") (42 . 0.0) (-4 . "AND>")))) (foreach MyEnt (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel))) (setq bulg (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget MyEnt)))) (if (/= (cdr (assoc 70 (entget MyEnt))) 1) (vl-remove (last bulg) bulg) ) (setq i 0) (foreach seg bulg (if (and (/= seg 0.0) (setq p1 (vlax-Curve-GetPointAtParam MyEnt i) mid (vlax-Curve-GetPointAtParam MyEnt (+ i 0.5)) p2 (vlax-Curve-GetPointAtParam MyEnt (+ i 1)) ) ) (progn ;pulled from here http://www.lee-mac.com/bulgeconversion.html#bulgearc (setq a (* 2 (atan seg)) r (/ (distance p1 p2) 2 (sin a)) c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r) ) (vla-AddDimArc mspace (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point mid)) ;(Command "_.DIMARC" MyEnt "_non" mid "_non" mid) ) ) (setq i (1+ i)) ) ) ) (vla-EndUndoMark doc) ;and this line (princ) ) Edited April 3, 2023 by mhupp forgot to define mspace 1 Quote
Engineer_Yasser Posted April 2, 2023 Author Posted April 2, 2023 3 hours ago, Tsuky said: In some cases, because it requires a selection point, depending on the zoom it may fail. The solution: make an object zoom in the loop. I present to you my solution with dimension But if the dimension is not necessary, I propose another solution to you which will be much faster, the zoom not being useful any more. (vl-load-com) (defun c:Dim_PolyArc ( / js AcDoc n ename obj pr pt_sel seg_bulge deriv alpha pt_dim) (princ "\nSelect polylines.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSelection is empty, or aren't POLYLINES!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndoMark AcDoc) (setvar "CMDECHO" 0) (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ename) pr -0.5 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq pt_sel (vlax-curve-GetPointAtParam obj (setq pr (1+ pr))) seg_bulge (vla-GetBulge obj (- pr 0.5)) deriv (vlax-curve-getFirstDeriv obj pr) alpha (- (atan (cadr deriv) (car deriv)) (* pi 0.5)) pt_dim (polar pt_sel alpha (* 2.0 (getvar "DIMTXT"))) ) (command "_.zoom" "_object" ename "") (if (not (zerop seg_bulge)) (command "_.dimarc" "_none" (trans pt_sel 0 1) "_none" (trans pt_sel 0 1)) (command "_.dimaligned" "_none" (trans (vlax-curve-GetPointAtParam obj (- pr 0.5)) 0 1) "_none" (trans (vlax-curve-GetPointAtParam obj (+ pr 0.5)) 0 1) "_none" (trans pt_sel 0 1) ) ) (command "_.zoom" "_previous") ) ) (setvar "CMDECHO" 1) (vla-EndUndoMark AcDoc) (prin1) ) (vl-load-com) (defun c:label_dist-vertex_po ( / js htx AcDoc Space nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha nw_obj) (princ "\nSelect polylines.") (while (null (setq js (ssget '( (0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") ) ) ) ) (princ "\nSelection is empty, or aren't POLYLINES!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify height text <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Label-vertex-poly")) (vlax-put (vla-add (vla-get-layers AcDoc) "Label-vertex-poly") 'color 7) ) ) (cond ((null (tblsearch "STYLE" "Length-vertex")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Length-vertex")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\Romantic.ttf") 0.0 0.0 1.0 0.0) ) ) ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 ) (repeat (fix (vlax-curve-getEndParam ename)) (setq dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr))) dist_end (vlax-curve-GetDistAtParam ename (1+ pr)) pt_start (vlax-curve-GetPointAtParam ename pr) pt_end (vlax-curve-GetPointAtParam ename (1+ pr)) seg_len (- dist_end dist_start) alpha (angle (trans pt_start 0 1) (trans pt_end 0 1)) ) (if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (vlax-curve-GetPointAtParam ename (+ 0.5 pr)))) 0.0 (rtos seg_len 2 2) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Length-vertex" "Label-vertex-poly" alpha) ) ;(vla-put-BackgroundFill nw_obj -1) ) ) (prin1) ) Thanks For the help ... the 1st code worked too slowly and at the end stopped randomly before finish the 2nd code is too fast and accurate .. I loved it but it's MText, not dimension. I need it dimension plz Quote
Engineer_Yasser Posted April 2, 2023 Author Posted April 2, 2023 1 hour ago, mhupp said: @Engineer_Yasser updated your code to work with polylines longer then one segment. Then I noticed depending on the zoom some dims might not be created. particularity the 7.40 and 14.52 . updating to visual lisp and not using command fixes this issue and should make it run faster. (defun c:test (/ sel myent bulg i p1 p2 mid a r c) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (if (setq sel (ssget '((-4 . "<AND") (0 . "*POLYLINE") (-4 . "<>") (42 . 0.0) (-4 . "AND>")))) (foreach MyEnt (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel))) (setq bulg (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget MyEnt)))) (if (/= (cdr (assoc 70 (entget MyEnt))) 1) (vl-remove (last bulg) bulg) ) (setq i 0) (foreach seg bulg (if (and (/= seg 0.0) (setq p1 (vlax-Curve-GetPointAtParam MyEnt i) mid (vlax-Curve-GetPointAtParam MyEnt (+ i 0.5)) p2 (vlax-Curve-GetPointAtParam MyEnt (+ i 1)) ) ) (progn ;pulled from here http://www.lee-mac.com/bulgeconversion.html#bulgearc (setq a (* 2 (atan seg)) r (/ (distance p1 p2) 2 (sin a)) c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r) ) (vla-AddDimArc mspace c p1 p2 mid) ;(Command "_.DIMARC" MyEnt "_non" mid "_non" mid) ) ) (setq i (1+ i)) ) ) ) (princ) ) I got an error when running the code as shown below error: bad argument type: VLA-OBJECT nil Quote
Tsuky Posted April 3, 2023 Posted April 3, 2023 2 hours ago, Engineer_Yasser said: Thanks For the help ... the 1st code worked too slowly and at the end stopped randomly before finish the 2nd code is too fast and accurate .. I loved it but it's MText, not dimension. I need it dimension plz As @mhupp points out, using (vla-AddDimArc) and (vla-AddDimAligned) will be faster. Here is the code (I should have done it before) Dim_PolyArc.lsp 1 1 Quote
mhupp Posted April 3, 2023 Posted April 3, 2023 6 hours ago, Engineer_Yasser said: I got an error when running the code as shown below error: bad argument type: VLA-OBJECT nil left out defining the mspace. should work now. Quote
Engineer_Yasser Posted April 3, 2023 Author Posted April 3, 2023 8 hours ago, mhupp said: @Engineer_Yasser updated your code to work with polylines longer then one segment. Then I noticed depending on the zoom some dims might not be created. particularity the 7.40 and 14.52 . updating to visual lisp and not using command fixes this issue and should make it run faster. (defun c:test (/ sel myent bulg i p1 p2 mid a r c) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq mspace (vla-get-ModelSpace doc)) ;forgot this line (if (setq sel (ssget '((-4 . "<AND") (0 . "*POLYLINE") (-4 . "<>") (42 . 0.0) (-4 . "AND>")))) (foreach MyEnt (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel))) (setq bulg (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget MyEnt)))) (if (/= (cdr (assoc 70 (entget MyEnt))) 1) (vl-remove (last bulg) bulg) ) (setq i 0) (foreach seg bulg (if (and (/= seg 0.0) (setq p1 (vlax-Curve-GetPointAtParam MyEnt i) mid (vlax-Curve-GetPointAtParam MyEnt (+ i 0.5)) p2 (vlax-Curve-GetPointAtParam MyEnt (+ i 1)) ) ) (progn ;pulled from here http://www.lee-mac.com/bulgeconversion.html#bulgearc (setq a (* 2 (atan seg)) r (/ (distance p1 p2) 2 (sin a)) c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r) ) (vla-AddDimArc mspace c p1 p2 mid) ;(Command "_.DIMARC" MyEnt "_non" mid "_non" mid) ) ) (setq i (1+ i)) ) ) ) (vla-EndUndoMark doc) ;and this line (princ) ) I got an error when running the code as shown below ; error: lisp value has no coercion to VARIANT with this type: (433828.0 2.92447e+06 0.0) Quote
mhupp Posted April 3, 2023 Posted April 3, 2023 Bricscad didn't need the "(vlax-3d-point" but i guess autocad does Quote
Engineer_Yasser Posted April 3, 2023 Author Posted April 3, 2023 10 hours ago, mhupp said: @Engineer_Yasser updated your code to work with polylines longer then one segment. Then I noticed depending on the zoom some dims might not be created. particularity the 7.40 and 14.52 . updating to visual lisp and not using command fixes this issue and should make it run faster. (defun c:test (/ sel myent bulg i p1 p2 mid a r c) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq mspace (vla-get-ModelSpace doc)) ;forgot this line (if (setq sel (ssget '((-4 . "<AND") (0 . "*POLYLINE") (-4 . "<>") (42 . 0.0) (-4 . "AND>")))) (foreach MyEnt (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel))) (setq bulg (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget MyEnt)))) (if (/= (cdr (assoc 70 (entget MyEnt))) 1) (vl-remove (last bulg) bulg) ) (setq i 0) (foreach seg bulg (if (and (/= seg 0.0) (setq p1 (vlax-Curve-GetPointAtParam MyEnt i) mid (vlax-Curve-GetPointAtParam MyEnt (+ i 0.5)) p2 (vlax-Curve-GetPointAtParam MyEnt (+ i 1)) ) ) (progn ;pulled from here http://www.lee-mac.com/bulgeconversion.html#bulgearc (setq a (* 2 (atan seg)) r (/ (distance p1 p2) 2 (sin a)) c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r) ) (vla-AddDimArc mspace (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point mid)) ;(Command "_.DIMARC" MyEnt "_non" mid "_non" mid) ) ) (setq i (1+ i)) ) ) ) (vla-EndUndoMark doc) ;and this line (princ) ) Thanks a lot .. this code worked fast and clear Quote
Engineer_Yasser Posted April 3, 2023 Author Posted April 3, 2023 6 hours ago, Tsuky said: As @mhupp points out, using (vla-AddDimArc) and (vla-AddDimAligned) will be faster. Here is the code (I should have done it before) Dim_PolyArc.lsp 1.48 kB · 3 downloads Thanks For Help ... Perfect Code .. combined both codes and worked for Polyline & curved Polyline Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.