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

[tnvsb]

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

 

[Emmanuel Delay]

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

[tnvsb]

Dear Sir,

 

I have tried your code, but not working. But anyway thanks for coming front to helping me.

[steven-g]

What isn't working? it works fine here!

[tnvsb]

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>

[Emmanuel Delay]

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)

[tnvsb]

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

[Emmanuel Delay]

Did you put all my code (of my last reply) in 1 lisp file?  I added a function insert.

[dlanorh]

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

[Emmanuel Delay]

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.

[dlanorh]

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