Code Red > AutoLISP (Vanilla / Visual)

Help with DoubleOffset lisp - LeeMac Code

(1/4) > >>

PM:
Hi. I am using LeeMac code for Double offset . I want an update to this code.
I need to select all lines in layer "ROOF-AXIS" and double offset them (0.08m of each side) and the put the offset lines in layer "ROOF"



--- Code - Auto/Visual Lisp: ---  (command "_layer" "_m" "ROOF" "_c" "90" "" "") 

--- Code - Auto/Visual Lisp: ---(defun c:DOff2 nil (c:DoubleOffset)) (defun c:DoubleOffset ( / *error* _StartUndo _EndUndo DoubleOffset doc exitflag layer mpoint obj object of point sel symbol value )   (defun *error* ( msg )        (and doc (_EndUndo doc))    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")        (princ (strcat "\n** Error: " msg " **")))    (princ)  )   (defun _StartUndo ( doc ) (vla-StartUndoMark doc))   (defun _EndUndo   ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc)))    (defun DoubleOffset ( object offset layer )    (mapcar      (function        (lambda ( o )          (if            (and              (not                (vl-catch-all-error-p                  (setq o                    (vl-catch-all-apply                      (function vlax-invoke) (list object 'Offset o)                    )                  )                )              )              layer            )            (mapcar              (function                (lambda ( o )                  (vla-put-layer o (getvar 'CLAYER))                )              )              o            )          )        )      )      (list offset (- offset))    )  )   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))   (mapcar    '(lambda ( symbol value ) (or (boundp symbol) (set symbol value)))    '(*dOff:Erase *dOff:Layer) '("No" "Source")  )   (if    (progn      (while        (progn          (princ            (strcat              "\nCurrent Settings: Erase source="              *dOff:Erase              "  Layer="              *dOff:Layer              "  OFFSETGAPTYPE="              (itoa (getvar 'OFFSETGAPTYPE))            )          )          (initget 6 "Through Erase Layer")          (setq of            (getdist              (strcat "\nSpecify Offset Distance [Through/Erase/Layer] <"                (if (minusp (getvar 'OFFSETDIST)) "Through"  (rtos (getvar 'OFFSETDIST))) "> : "              )            )          )          (cond            (              (null of) (not (setq of (getvar 'OFFSETDIST)))            )            (              (eq "Through" of) (setq of (setvar 'OFFSETDIST -1)) nil            )            (              (eq "Erase" of) (initget "Yes No")               (setq *dOff:Erase                (cond                  (                    (getkword                      (strcat "\nErase source object after offsetting? [Yes/No] <" *doff:Erase "> : ")                    )                  )                  ( *dOff:Erase )                )              )            )            (              (eq "Layer" of) (initget "Current Source")               (setq *dOff:Layer                (cond                  (                    (getkword                      (strcat "\nEnter layer option for offset objects [Current/Source] <" *dOff:Layer "> : ")                    )                  )                  ( *dOff:Layer )                )              )            )            ( of (setvar 'OFFSETDIST of) nil )          )        )      )      of    )    (while      (progn        (or ExitFlag          (progn (initget "Exit")            (setq sel (entsel "\nSelect object to offset or [Exit] <Exit> : "))          )        )                (cond          (            (or ExitFlag (null sel) (eq sel "Exit")) nil          )          ( (vl-consp sel)             (_EndUndo doc) (_StartUndo doc)             (if (and (wcmatch (cdr (assoc 0 (entget (car sel)))) "ARC,CIRCLE,ELLIPSE,SPLINE,LWPOLYLINE,XLINE,LINE")                     (setq obj (vlax-ename->vla-object (car sel))))               (if (minusp of)                (if                  (progn (initget "Exit Multiple")                    (and                      (setq point (getpoint "\nSpecify through point or [Exit/Multiple] <Exit> : "))                      (not (eq "Exit" point))                    )                  )                  (if (eq "Multiple" point)                    (while                      (progn (initget "Exit")                        (setq mpoint (getpoint "\nSpecify through point or [Exit] <next object> : "))                         (cond                          (                            (eq "Exit" mpoint)                             (if (eq "Yes" *dOff:Erase) (vla-delete obj))                             (not (setq ExitFlag t))                          )                          (                            (null mpoint)                             (if (eq "Yes" *dOff:Erase) (vla-delete obj))                             nil                          )                          (                            (listp mpoint)                                                       (DoubleOffset obj                              (distance (trans mpoint 1 0)                                (vlax-curve-getClosestPointto (car sel) (trans mpoint 1 0) t)                              )                              (eq "Current" *dOff:Layer)                            )                           t                          )                        )                      )                    )                    (progn                      (DoubleOffset obj                        (distance (trans point 1 0)                          (vlax-curve-getClosestPointto (car sel) (trans point 1 0) t)                        )                        (eq "Current" *dOff:Layer)                      )                      (if (eq "Yes" *dOff:Erase) (vla-delete obj))                     t                    )                  )                  (setq ExitFlag t)                )                (progn                  (DoubleOffset obj of (eq "Current" *dOff:Layer))                   (if (eq "Yes" *dOff:Erase) (vla-delete obj))                )              )              (princ "\n** Cannot Offset that Object **")            )           t          )        )      )    )  )    (_EndUndo doc) (princ))    (vl-load-com) (princ)  
Thanks

Tharwat:
Here you go.

--- Code - Auto/Visual Lisp: ---(defun c:Test ( / sel int ent )  ;; Tharwat - Date : 10.Apr.2021       ;;  (and (or (tblsearch "LAYER" "ROOF")         (alert "Layer name < ROOF >  was not found in this drawing to continue!")         )     (princ "\nSelect lines on layer < ROOF-AXIS > to offset on two sides 0.08 m : ")     (setq int -1 sel (ssget "_:L" '((0 . "LINE")(8 . "ROOF-AXIS"))))     (while (setq int (1+ int) ent (ssname sel int))       (foreach off '(0.08 -0.08)         (vla-put-layer (car (vlax-invoke (vlax-ename->vla-object ent) 'offset off)) "ROOF")         )       )     )(princ)) (vl-load-com) 

PM:
HI Tharwat

I try to change your code to automatic select this lines by is not work !!!




--- Code - Auto/Visual Lisp: ---    (defun c:Test ( / sel int ent )      ;; Tharwat - Date : 10.Apr.2021       ;;      (and (or (tblsearch "LAYER" "ROOF")             (alert "Layer name < ROOF >  was not found in this drawing to continue!")             )         ;(princ "\nSelect lines on layer < ROOF-AXIS > to offset on two sides 0.08 m : ")         (ssget "_x" '((0 . "*LINE") (8 . "ROOF-AXIS")))  ; < ----- add this line         (setq int -1 sel (ssget "_:L" '((0 . "LINE")(8 . "ROOF-AXIS"))))         (while (setq int (1+ int) ent (ssname sel int))           (foreach off '(0.08 -0.08)             (vla-put-layer (car (vlax-invoke (vlax-ename->vla-object ent) 'offset off)) "ROOF")             )           )         )    (princ)    ) (vl-load-com)       

Tharwat:
Replace this part from my original posted codes and please modify your post and remove your posted codes.

--- Code - Auto/Visual Lisp: --- (setq int -1 sel (ssget "_X" '((0 . "LINE")(8 . "ROOF-AXIS"))))
Be sure to have the layer ROOF-AXIS unlocked.

PM:
Thanks

Navigation

[0] Message Index

[#] Next page