AutoLISP code assistance: Removing offset operation

94 views Asked by At

I'm working on an AutoLISP script in AutoCAD that involves offsetting polylines, and I'm encountering issues with the offseting part. However, I've decided that I want to remove the offset operation entirely from the code.

Here are the key points:

  1. I have a function named FM_RM3 that is intended to offset polylines based on a specified layer and direction.
  2. I've realized that I no longer need the offset operation and would like to modify the code to work directly with the original coordinates of the polylines.
  3. I'm seeking assistance in removing the offset-related code from the FM_RM3 function. Any help or guidance on which specific lines to remove for this purpose would be highly appreciated.
(defun c:FM_RM3
    (/ ss sset layer echo temp offdist direction n en ed pt LL UR MP minpoint maxpoint
       area1 area2 newpoly vtx ucsFlag enExtr)

;start offset multi polylines----------

(command "._undo" "_begin")

;verwijderen bestaande polylines op specifieke layer "*":
(setq ss (ssget "X" '((0 . "*LWPOLYLINE") (8 . "0"))))
(command "erase" ss "")


;selecteren polylines op specifieke layer:
(setq ss (ssget "X" '((0 . "*LWPOLYLINE") (8 . "00---0--FM-RUIMTEDEFV")))) 

;bepalen naar welke layer offset "*":
(or (tblsearch "LAYER" "0") (command "_.LAYER" "_New" "0" "")) (setq LAYER "0") 

  ;afstand van offset fixed:
  (setq offdist 5)
  ;richting van offset fixed:
  (setq direction "Out")

  (if (= direction "Out")
      (progn  ;;OUT
        (setq n 0)
        (setq pt (list (1+ (car (getvar 'extmax)))
                       (1+ (cadr (getvar 'extmax)))))
        (repeat (sslength ss)
          (setq en (ssname ss n))
          (if (not (= 8 (logand 8 (cdr (assoc 70 (entget en))))));no 3Dp
            (progn
            (command "._offset" offdist en pt "")
            (SetQ ENTITY (EntLast)
                  ENTITY (EntGet ENTITY)
                  ENTITY (SubSt (Cons 8 LAYER) (Assoc 8 ENTITY) ENTITY)
            )
            (EntMod ENTITY)
            )
            )
          (setq n (1+ n))
          )
        )

      (progn  ;;IN
        (setq n 0)
          (repeat (sslength ss)
            (setq ucsFlag nil)
            (setq en (ssname ss n))
            (setq ed (entget en))
            (if (not (= 8 (logand 8 (cdr (assoc 70 ed)))))
                (progn
                  (setq enExtr (cadddr (assoc 210 ed)))
                  (if (not (= enExtr (caddr (trans '( 0.0 0.0 1.0) 0 1))))
                    (progn
                      (setq elev
                         (cond
                           ((= enType "LWPOLYLINE")
                            (cdr (assoc 38 ed))
                           )
                           (T
                            (caddr (cdr (assoc 10 ed)))
                           )
                         );cond
                       )
                      (command "._ucs" "_3point"
                        (trans (list 0.0 0.0 elev) en 1)
                        (trans (list 1.0 0.0 elev) en 1)
                        (trans (list 0.0 1.0 elev) en 1)
                        )
                      (setq ucsFlag T)
                    )
                  )

                  (setq obj (vlax-ename->vla-object en))
                  (vla-getboundingbox obj 'minpoint 'maxpoint)
                  (setq LL (trans (vlax-safearray->list minpoint) 0 1)
                        UR (trans (vlax-safearray->list maxpoint) 0 1)
                        MP (list (/ (+ (car LL) (car UR)) 2.0)
                                 (/ (+ (cadr LL) (cadr UR)) 2.0))
                        )
                  (command "._area" "_object" en)
                  (setq area1 (getvar 'area))
     ;;MP is approximate centroid of polyline - test if in fact inside
                  (command "._offset" offdist en MP "")
                  (SetQ ENTITY (EntLast)
                        ENTITY (EntGet ENTITY)
                        ENTITY (SubSt (Cons 8 LAYER) (Assoc 8 ENTITY) ENTITY)
                  )
                  (EntMod ENTITY)
                  (setq newpoly (entlast))
                  (command "._area" "_object" newpoly)
                  (setq area2 (getvar 'area))
     ;;if new polyline is outside the original, offset it
     ;;twice the original distance in the other direction
                  (if (> area2 area1)
                    (progn
                      (setq vtx (entnext (entnext en)))
                      (setq pt
                        (trans (cdr (assoc 10 (entget vtx))) 0 1))
                      (command "._offset" (* 2.0 offdist) newpoly pt "")
                      (SetQ ENTITY (EntLast)
                            ENTITY (EntGet ENTITY)
                            ENTITY (SubSt (Cons 8 LAYER) (Assoc 8 ENTITY) ENTITY)
                      )
                      (EntMod ENTITY)

                      (entdel newpoly)
                      )
                     )
                    )
                  )
              (if ucsFlag (command "._ucs" "_p"))
              (setq n (1+ n))
            );;repeat
          )
      )


;einde offset multi polylines----------



;start export coordinaten----------

  ;selecteren polylines op specifieke layer:
  (setq sset (ssget "X" '((0 . "LWPOLYLINE") (8 . "0")))) 


(if sset

   (progn

     (setq itm 0 num (sslength sset))

     ;opslaan als met dialoog:
     ;(setq fn (getfiled "Point Export File" "" "txt" 1))
     ;direct opslaan in directory van dwg en met naam van de tekening:
     (setq fn (strcat (getvar 'DWGPREFIX) (vl-string-subst "txt" "dwg" (getvar 'DWGNAME))))
     


     (if (/= fn nil)

       (progn

         (setq fh (open fn "w"))

         (while (< itm num)

         (setq hnd (ssname sset itm))

           (setq ent (entget hnd))

           (setq obj (cdr (assoc 0 ent)))

           (cond

             ((= obj "POINT")

               (setq pnt (cdr (assoc 10 ent)))

               (setq pnt (trans pnt 0 1));;**CAB

               (princ (strcat (rtos (car pnt) 2 8) ","

                               (rtos (cadr pnt) 2 8) ","

                               (rtos (caddr pnt) 2 8)) fh)

               (princ "\n" fh)

             )

             ((= obj "LWPOLYLINE")


         ; ID hyperlink;            
         ;(princ (geturl hnd) fh)
         ; ID d.m.v. handle;
          (princ (cdr (assoc 5 ENTITY)) fh)
              (princ "\n" fh)

               (if (= (cdr (assoc 38 ent)) nil)

                 (setq elv 0.0)

                 (setq elv (cdr (assoc 38 ent)))

               )

               (foreach rec ent

                 (if (= (car rec) 10)

                   (progn

                     (setq pnt (cdr rec))

                     (setq pnt (trans pnt 0 1));;**CAB

                     (princ (strcat (rtos (car pnt) 2 8) ","

                                     (rtos (cadr pnt) 2 8) ","

                                    (rtos elv 2 8)) fh)

                     (princ "\n" fh)

                   )

                 )

               )

             )

             (t nil)

           )

           (setq itm (1+ itm))

         )

        (close fh)

       )

     )

   )

)

;einde export coordinaten----------

;verwijderen bestaande polylines op specifieke layer "*":
(setq ss (ssget "X" '((0 . "*LWPOLYLINE") (8 . "0"))))
(command "erase" ss "")


(princ)
);;defun

(defun c:ompnl ()
  (c:offsetmultiplepolylinestonewlayer)
  )

(princ "\nFM_RM3 loaded. Type FM_RM3 to run.")
;(princ "\nOffsetMultiplePolylinestoNewLayer loaded. Type OMPNL to run.")
(princ)
(vl-load-com)

1

There are 1 answers

1
dexus On

I think you can just remove the part between

;afstand van offset fixed:

and

;einde offset multi polylines----------

and you'll have what you need.