About OFFSET I want to add some functions, this LISP has some problems

[wk9128]

(defun c:myoffset (/ ss offset_dis layer_entry layer_name color_name line_name confirm new_ents)
  (setq ss (ssget)
        offset_dis 0.0
        layer_name ""
        color_name ""
        line_name ""
        confirm ""
        new_ents nil)
  (if ss
      (progn
        (setq offset_dis (getdist "\nPlease offset distance: ")
              layer_entry (tblsearch "LAYER" (cdr (assoc 8 (entget (ssname ss 0))))))
        (if layer_entry
            (setq layer_name (cdr (assoc 2 layer_entry)))
          (setq layer_name ""))
        (setq color_name (acad_colordlg 7))
        (setq line_name (strcase (strtrim (getstring t "\nPlease select a linetype for the new object:\n1.Solid line\n2.Center line\n3.Dashed line\n\nPlease enter line style options:"))))
        (setq confirm (strcase (strtrim (getstring t "\nAre you sure you want to offset the object? (Y/N): "))))
        (if (= confirm "Y")
            (progn
              (command ".OFFSET" offset_dis ss "")
              (setq new_ents (nentselp "\nPlease select the new object: "))
              (vla-put-color (vlax-ename->vla-object (car new_ents)) color_name)
              (if (= line_name "1") (command ".CHPROP" new_ents "" "LT" "continuous"))
              (if (= line_name "2") (command ".CHPROP" new_ents "" "LT" "center"))
              (if (= line_name "3") (command ".CHPROP" new_ents "" "LT" "dashed"))
              (if layer_name (command ".CHPROP" new_ents "" "LA" layer_name)))
          (princ "\nOperation canceled!")))
    (princ "\nNo objects selected!"))
  (princ))

(defun acad_colordlg ( init / r g b )
  (if (not (and (setq r (car init))
                (setq g (cadr init))
                (setq b (caddr init))))
    (setq r 255 g 255 b 255)
  )
  (vl-cmdf "_.-COLOR %d %d %d" r g b)

Can you help me modify it?

Can someone please help me ? It would be much appreciated. Thanks in advance

[pkenewell]

12 hours ago, wk9128 said:

Can someone please help me ? It would be much appreciated. Thanks in advance

Please tell us HOW you want to modify this. What do you want added or changed? Without looking into it - Is there something not functioning as intended?

[pkenewell]

@wk9128 Well - I don't understand what you want, but after reviewing the code, this is how I would write it. It's a little bit of a hack on the color stuff, switching between using DXF codes and ActiveX. I also don't know why you wouldn't want to pick a side to offset?

 

This Code does several things that the original code does not do well. Note the use of Keywords and defaults that follow AutoCAD command behavior based on the prompt formatting.

Also note that when variables are localized, you don't have to reset their value at the top of the function; they will only have a value within the scope of the function. The exceptions are global variables, like the 1 in my code below "def:ofd", which will retain it's value while in the drawing session.

(defun c:MyOffset2 (/ clr doc elst ent lt lts lyrn obj nent nobj)
   (vl-load-com)
   (if (not def:ofd) (setq def:ofd 1.0))
   (if (and
         (setq ent (entsel "\nSelect Object to Offset: "))
         (if (Setq ofd (getdist (strcat "\nPlease Enter an Offset Distance <" (rtos def:ofd) ">: ")))(setq def:ofd ofd)(setq ofd def:ofd))
         (progn
            (initget "Solid Center Dashed")
            (if (= (setq lt (getKword "\nSelect a Linetype for the New Object [Solid/Center/Dashed] <Solid>: ")) nil)(setq lt "Solid") lt)
         )
         (if (not (setq clr (acad_colordlg 256)))(setq clr 256) clr)
         (progn
           (initget "Yes No")
           (if (= (setq conf (getKword "\nAre You Sure you want to Offset this Object? [Yes/No] <Yes>: ")) nil)(setq conf "Yes") conf)
         )
      )
      (progn
         (setq obj  (vlax-ename->vla-object (car ent))
               lyrn (vla-get-layer obj)
               doc  (vla-get-activedocument (vlax-get-acad-object))
               lts  (vla-get-linetypes doc)
               lt   (if (= lt "Solid") "Continuous" lt)
         )
         (if (not (tblsearch "LTYPE" lt))(vla-load lts lt "acad.lin"))
         (vla-offset obj ofd)
         (if (and (setq nent (entlast))(setq nobj (vlax-ename->vla-object nent) elst (entget nent)))
            (progn
               (if clr (entmod (if (assoc 62 elst)(subst (cons 62 clr)(assoc 62 elst) elst)(append elst (list (cons 62 clr))))))
               (entupd nent)
               (if (tblsearch "LTYPE" lt)(vla-put-Linetype nobj lt))
               (vla-put-layer nobj lyrn)
            )
         )
      )
      (princ "\nNo Object Selected.")
   )
   (princ)
)

 

Edited March 30, 2023 by pkenewell

[wk9128]

4 hours ago, pkenewell said:

@wk9128 Well - I don't understand what you want, but after reviewing the code, this is how I would write it. It's a little bit of a hack on the color stuff, switching between using DXF codes and ActiveX. I also don't know why you wouldn't want to pick a side to offset?

 

This Code does several things that the original code does not do well. Note the use of Keywords and defaults that follow AutoCAD command behavior based on the prompt formatting.

Also note that when variables are localized, you don't have to reset their value at the top of the function; they will only have a value within the scope of the function. The exceptions are global variables, like the 1 in my code below "def:ofd", which will retain it's value while in the drawing session.

(defun c:MyOffset2 (/ clr doc elst ent lt lts lyrn obj nent nobj)
   (vl-load-com)
   (if (not def:ofd) (setq def:ofd 1.0))
   (if (and
         (setq ent (entsel "\nSelect Object to Offset: "))
         (if (Setq ofd (getdist (strcat "\nPlease Enter an Offset Distance <" (rtos def:ofd) ">: ")))(setq def:ofd ofd)(setq ofd def:ofd))
         (progn
            (initget "Solid Center Dashed")
            (if (= (setq lt (getKword "\nSelect a Linetype for the New Object [Solid/Center/Dashed] <Solid>: ")) nil)(setq lt "Solid") lt)
         )
         (if (not (setq clr (acad_colordlg 256)))(setq clr 256) clr)
         (progn
           (initget "Yes No")
           (if (= (setq conf (getKword "\nAre You Sure you want to Offset this Object? [Yes/No] <Yes>: ")) nil)(setq conf "Yes") conf)
         )
      )
      (progn
         (setq obj  (vlax-ename->vla-object (car ent))
               lyrn (vla-get-layer obj)
               doc  (vla-get-activedocument (vlax-get-acad-object))
               lts  (vla-get-linetypes doc)
               lt   (if (= lt "Solid") "Continuous" lt)
         )
         (if (not (tblsearch "LTYPE" lt))(vla-load lts lt "acad.lin"))
         (vla-offset obj ofd)
         (if (and (setq nent (entlast))(setq nobj (vlax-ename->vla-object nent) elst (entget nent)))
            (progn
               (if clr (entmod (if (assoc 62 elst)(subst (cons 62 clr)(assoc 62 elst) elst)(append elst (list (cons 62 clr))))))
               (entupd nent)
               (if (tblsearch "LTYPE" lt)(vla-put-Linetype nobj lt))
               (vla-put-layer nobj lyrn)
            )
         )
      )
      (princ "\nNo Object Selected.")
   )
   (princ)
)

 

Wow, you are amazing, that means, thank you so much for your help

[pkenewell]

13 minutes ago, wk9128 said:

Wow, you are amazing, that means, thank you so much for your help

You Welcome. However, please test it and let me know how it works for you. I think the code needs some more finessing before I would consider it good.

[wk9128]

HI pkenewell , it is still in testing, if there is anything to improve or the question will be asked again.

[wk9128]

An error occurred during execution, please correct

Command: MYOFFSET3
Select Destination Layer:
Select Object to Offset:
Please Enter an Offset Distance <50>: 100
Select a Linetype for the New Object [Solid/Center/Dashed] <Solid>: C
; error: ActiveX Server returned the error: unknown name: Offset

 

(defun c:MYOFFSET3 (/ clr doc elst ent layer lt lts lyrn nent nobj ofd)
  (vl-load-com)
  
  (setq layer (car (entsel "\nSelect Destination Layer: ")))
  (if (not layer)
      (progn
        (princ "\nNo Layer Selected.")
        (exit)
      )
  )
  
  (setq ent (entsel "\nSelect Object to Offset: "))
  (if (not ent)
      (progn
        (princ "\nNo Object Selected.")
        (exit)
      )
  )
  
  (if (setq ofd (getdist (strcat "\nPlease Enter an Offset Distance <50>: ")))
      (setq ofd (rtos ofd))
      (setq ofd "50")
  )
  
  (initget "Solid Center Dashed")
  (setq lt (getKword "\nSelect a Linetype for the New Object [Solid/Center/Dashed] <Solid>: "))
  (if (not lt)
      (setq lt "Solid")
  )
  (setq lt (strcase lt))
  (if (= lt "C")
      (setq lt "Center")
  )
  
  (setq clr (acad_colordlg 256))
  (if (not clr)
      (setq clr 256)
  )
  
  (setq obj (vlax-ename->vla-object (car ent))
        lyrn (vla-get-layer obj)
        doc (vla-get-activedocument (vlax-get-acad-object))
        lts (vla-get-linetypes doc)
        lt (if (= lt "Solid") "Continuous" lt)
  )
  (if (not (tblsearch "LTYPE" lt))
      (vla-load lts lt "acad.lin")
  )
  
  (vla-offset obj (atof ofd))
  
  (if (and (setq nent (entlast)) (setq nobj (vlax-ename->vla-object nent) elst (entget nent)))
      (progn
        (if clr
            (entmod (if (assoc 62 elst)
                        (subst (cons 62 clr) (assoc 62 elst) elst)
                        (append elst (list (cons 62 clr)))
                     )
            )
        )
        (entupd nent)
        (if (tblsearch "LTYPE" lt)
            (vla-put-Linetype nobj lt)
        )
        (vla-put-layer nobj layer)
      )
  )
  
  (princ)
)

 

[BIGAL]

"Please Enter an Offset Distance <50>: 100" if you use the vla-offset method it supports a -ve value to imply go left rather than default right. a few more rules to this is pick say open pline near an end so implies direction of pline, If its closed plines check its CW or CCW so +ve is to outside.

 

 

Edited April 6, 2023 by BIGAL

[wk9128]

hi BIGAL It can be used, but there will be a red text message, how to eliminate it?

MYOFFSET3
Select Destination Layer:
Select Object to Offset:
Please Enter an Offset Distance <50>: 75
Select a Linetype for the New Object [Solid/Center/Dashed] <Solid>: D
; error: lisp value has no coercion to VARIANT with this type:  <Entity name: 1c20e90e8f0>
Command: