Engineer_Yasser Posted April 1, 2023 Share 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 Link to comment Share on other sites More sharing options...
rlx Posted April 1, 2023 Share Posted April 1, 2023 haven't tested your routine but my first guess would be to declare / localize all your variables 1 Quote Link to comment Share on other sites More sharing options...
Tsuky Posted April 1, 2023 Share Posted April 1, 2023 In the place of: (command "_.DIMARC" MyEnt mid mid) Try this instead: (command "_.DIMARC" "_none" mid "_none" mid) Quote Link to comment Share on other sites More sharing options...
rlx Posted April 2, 2023 Share Posted April 2, 2023 wouldn't you need MyEnt? Quote Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 2, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
Steven P Posted April 2, 2023 Share 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 Link to comment Share on other sites More sharing options...
Tsuky Posted April 2, 2023 Share 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 Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 2, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
Tsuky Posted April 2, 2023 Share 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 Link to comment Share on other sites More sharing options...
mhupp Posted April 2, 2023 Share 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 Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 2, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 2, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
Tsuky Posted April 3, 2023 Share 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 Link to comment Share on other sites More sharing options...
mhupp Posted April 3, 2023 Share 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 Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 3, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
mhupp Posted April 3, 2023 Share Posted April 3, 2023 Bricscad didn't need the "(vlax-3d-point" but i guess autocad does Quote Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 3, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
Engineer_Yasser Posted April 3, 2023 Author Share 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 Link to comment Share on other sites More sharing options...
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.