Jump to content

Problem with function ACET-.......


pawcyk
 Share

Recommended Posts

Hello everybody.

Can anyone halp me with this code:

 

defun getfencesel (en flt / fe ss)    
     (vl-cmdf "_ZOOM" "_E")
  (setq ss (ssadd en))
     (setq fe (acet-list-remove-adjacent-dups (acet-geom-object-point-list en 0.05)) 
           ss (ssget "_F" fe flt)
     )
     (vl-cmdf "_ZOOM" "_P")
     ss
  )

 

Maybe someone known how it rewrite into normal Autolisp or Vlisp??

Edited by rkmcswain
Added [CODE] tags
Link to comment
Share on other sites

Heres my attempt:

; (sssetfirst nil (GetFenceSel (car (entsel)) '((0 . "*TEXT")) 3))
; (sssetfirst nil (GetFenceSel (car (entsel)) nil 3))
(defun GetFenceSel ( e flt prec / DivideCurveAtInc Trap pL ll ur SS )
 
 (defun DivideCurveAtInc ( i c / TotLen d PtLst )
   (if
     (and
       (numberp i) (not (or (zerop i) (minusp i)))
       (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list c)))) 
       (<= i (setq TotLen (vlax-curve-getDistAtParam c (vlax-curve-getEndParam c))))
     )
     (progn
       (setq d 0.0)
       (while (<= d TotLen)
         (setq PtLst (cons (vlax-curve-getPointAtDist c d) PtLst))
         (setq d (+ d i))
       ); while
       (setq PtLst (reverse PtLst))
     ); progn
   ); if
   PtLst
 ); defun DivideCurveAtInc
 
 (defun Trap ( f L / r err ) (if (setq err (not (vl-catch-all-error-p (setq r (vl-catch-all-apply f L))))) (if r r err)) )
 (cond
   ( (not (setq e (Trap 'vlax-ename->vla-object (list e))))
     (princ "\nNo object provided.")
   )
   ( (not (Trap 'vla-GetBoundingBox (list e 'll 'ur)))
     (princ "\nInvalid object.")
   )
   (
     (or
       (and
         (Trap 'vlax-curve-getEndParam (list e))
         (setq pL (mapcar '(lambda (x) (reverse (cdr (reverse x)))) (DivideCurveAtInc prec e)))
       )
       (setq pL
         (
           (lambda ( x / p1 p2 ) (setq p1 (car x)) (setq p2 (cadr x)) (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1))) )
           (mapcar '(lambda (x) (reverse (cdr (reverse (safearray-value x))))) (list ll ur))
         )
       )
     ); or
     (vla-ZoomWindow (vlax-get-acad-object) ll ur)
     (and
       (setq SS (ssget "_F" pL flt))
       (ssadd (vlax-vla-object->ename e) SS)
     )
     (vla-ZoomPrevious (vlax-get-acad-object))
   )
 ); cond
 SS
); defun GetFenceSel
(vl-load-com) (princ)

Where 'prec is the unit increment for the curve to be divided.

 

HTH

Link to comment
Share on other sites

I've put wrong code. This is corect:

 

(defun getfencesel (en flt / fe ss)    
     (acet-ss-zoom-extents (setq ss (ssadd en)))
     (setq fe (acet-list-remove-adjacent-dups (acet-geom-object-point-list en 0.05)) 
           ss (ssget "_F" fe flt)
     )
     (vl-cmdf "_ZOOM" "_P")
     ss
  )

 

The all lisp is here:

https://www.theswamp.org/index.php?topic=9042.465

 

File: TriangV0.6.7.LSP by ymg

 

Becouse my CAD don't have Acad Express Tools so I have to change the TriangV0.6.7.LSP.

I've changed the parts with function:

pragma

vl-times

acet-ui-progress

..adne command TIN is working, but PROF still isn't.

 

I've put grrr code instead fragment with error but it doesn't work. My knowledge of this is over.

I'm still using COMAND ;)

 

I will be grateful for your help.

 

Pawcyk

Edited by rkmcswain
Added [CODE] tags
Link to comment
Share on other sites

Can I change my posts now? If not I will try do it corectly in the future. My english isn't as good as I want thats why I could missed it.

 

Pawcyk

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

 Share

×
×
  • Create New...