Jump to content

Hi Helpers, Need a urgent help in small modification of lisp code


tnvsb

Recommended Posts

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)
)

 

Link to comment
Share on other sites

(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)
)


Link to comment
Share on other sites

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>

Link to comment
Share on other sites

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 by Emmanuel Delay
better version of (getAngle)
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

:P

Edited by dlanorh
  • Like 1
Link to comment
Share on other sites

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))
  )
)

 

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...