Jump to content

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

wk9128

By wk9128
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

wk9128 Apprentice

wk9128

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

Link to comment
Share on other sites
pkenewell Proficient

pkenewell

Posted
Posted
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?

Link to comment
Share on other sites
pkenewell Proficient

pkenewell

Posted
Posted (edited)

@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 by pkenewell
Link to comment
Share on other sites
wk9128 Apprentice

wk9128

Posted
  • Author
Posted
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

  • Like 1
Link to comment
Share on other sites
pkenewell Proficient

pkenewell

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

Link to comment
Share on other sites
wk9128 Apprentice

wk9128

Posted
  • Author
Posted

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

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

"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 by BIGAL
Link to comment
Share on other sites
wk9128 Apprentice

wk9128

Posted
  • Author
Posted

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:

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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
Go to topic listing
×
×
  • Create New...