tnvsb Posted September 27, 2018 Share Posted September 27, 2018 Dear Helpers, I need a small modification in below code. This code works for "MEASURE" command on mutiple selected polylines. The same I need for "DIVIDE" command also. Can anybody help me. (defun c:MEB(/ blk ss l name) ; TharwaT 04. 04. 2011 (if (and (setq blk (entsel "\n Select Block :")) (setq ss (ssget "_:L" '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE")))) (setq l (getdist "\n Distance between Blocks :")) (setq scl (getdist "\n Enter a scale :")) ) (progn (setq name (cdr (assoc 2 (entget (car blk))))) ((lambda (i / ss1) (while (setq ss1 (ssname ss (setq i (1+ i)))) (setq marker(entlast)) (command "_.measure" ss1 "Block" name "_Y" l) (while (setq en (entnext marker)) (setq elist (entget en) pt (cdr (assoc 10 elist))) (command "_scale" en "" "_non" pt scl) (princ (cdr (assoc 2 elist))) (entupd en) (setq marker en) ) ) ) -1 ) ) (princ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 27, 2018 Share Posted September 27, 2018 (defun c:DEB(/ blk ss s name) (if (and (setq blk (entsel "\nSelect Block: ")) (setq ss (ssget "_:L" '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE")))) (setq s (getint "\nEnter the number of segments: ")) (setq scl (getdist "\n Enter a scale :")) ) (progn (setq name (cdr (assoc 2 (entget (car blk))))) ((lambda (i / ss1) (while (setq ss1 (ssname ss (setq i (1+ i)))) (setq marker(entlast)) (command "_.divide" ss1 "Block" name "_Y" s) (while (setq en (entnext marker)) (setq elist (entget en) pt (cdr (assoc 10 elist))) (command "_scale" en "" "_non" pt scl) (princ (cdr (assoc 2 elist))) (entupd en) (setq marker en) ) ) ) -1 ) ) (princ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
tnvsb Posted September 27, 2018 Author Share Posted September 27, 2018 Dear Sir, I have tried your code, but not working. But anyway thanks for coming front to helping me. Quote Link to comment Share on other sites More sharing options...
steven-g Posted September 27, 2018 Share Posted September 27, 2018 What isn't working? it works fine here! Quote Link to comment Share on other sites More sharing options...
tnvsb Posted September 28, 2018 Author Share Posted September 28, 2018 Pleae see the error code from autocad as below. Command: DEB Select Block: Select objects: 1 found Select objects: Enter the number of segments: 5 Enter a scale :0.075 _.divide Unknown command "DIVIDE". Press F1 for help. Command: <Entity name: 6A3CC190> Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 28, 2018 Share Posted September 28, 2018 (edited) That is weird. See if this works, I wrote a custom divide. If anybody has a more elegant way than my (getAngle), please post it. (vl-load-com) (defun Insert (pt Nme scale rotation) (entmakex (list (cons 0 "INSERT") (cons 2 Nme) (cons 10 pt) (cons 41 scale) (cons 42 scale) (cons 43 scale) (cons 50 rotation) )) ) ;;(defun getAngle (pl dist / param) ;; (setq ip1 (vlax-curve-getPointAtDist pl (- dist 0.001) )) ;; (setq ip2 (vlax-curve-getPointAtDist pl (+ dist 0.001) )) ;; (angle ip1 ip2) ;;) (defun getAngle (obj dist / ) (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatdist obj dist))) ) (defun customDivide (block pl segments sc / d2 ip i ang dist) (setq d2 (vla-get-length (vlax-ename->vla-object pl) )) (setq i 1) (repeat (- segments 1) (setq ip (vlax-curve-getPointAtDist pl (setq dist (* i (/ d2 segments)) ))) (setq ang (getAngle pl dist)) (Insert ip block sc ang ) (setq I (+ i 1)) ) ) (defun c:DEB(/ blk ss s name) (if (and (setq blk (entsel "\nSelect Block: ")) (setq ss (ssget "_:L" '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE")))) (setq s (getint "\nEnter the number of segments: ")) (setq scl (getdist "\nEnter a scale : ")) ) (progn (setq name (cdr (assoc 2 (entget (car blk))))) ((lambda (i / ss1) (while (setq ss1 (ssname ss (setq i (1+ i)))) (customDivide name ss1 s scl) ) ) -1 ) ) (princ) ) (princ) ) Edited September 28, 2018 by Emmanuel Delay better version of (getAngle) Quote Link to comment Share on other sites More sharing options...
tnvsb Posted September 28, 2018 Author Share Posted September 28, 2018 Hi I have tried your code, but came error: Command: deb Select Block: Select objects: Specify opposite corner: 2 found Select objects: Enter the number of segments: 10 Enter a scale : 1 ; error: no function definition: INSERT Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 28, 2018 Share Posted September 28, 2018 Did you put all my code (of my last reply) in 1 lisp file? I added a function insert. Quote Link to comment Share on other sites More sharing options...
dlanorh Posted September 28, 2018 Share Posted September 28, 2018 (edited) 3 hours ago, Emmanuel Delay said: That is weird. If anybody has a more elegant way than my (getAngle), please post it. (defun getAngle (obj dist / ) (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatdist obj dist))) );end_defun Edited September 28, 2018 by dlanorh 1 Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted September 28, 2018 Share Posted September 28, 2018 Thanks. I figured I needed vlax-curve-getfirstderiv, I couldn't get it to work. Well, I didn't know how to get an angle out of it. Quote Link to comment Share on other sites More sharing options...
dlanorh Posted September 28, 2018 Share Posted September 28, 2018 6 minutes ago, Emmanuel Delay said: Thanks. I figured I needed vlax-curve-getfirstderiv, I couldn't get it to work. Well, I didn't know how to get an angle out of it. The returned angle is always in the direction of the "curve" You could plug it straight into your "customdivide" sub function thus eliminating the "getAngle" sub function (defun customDivide (block pl segments sc / d2 obj ip i ang dist) (setq d2 (vla-get-length (setq obj (vlax-ename->vla-object pl))) (setq i 1) (repeat (- segments 1) (setq ip (vlax-curve-getPointAtDist pl (setq dist (* i (/ d2 segments)) ))) (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatdist obj dist))) (Insert ip block sc ang ) (setq I (+ i 1)) ) ) 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.