CPO Lisp

I am trying to write a lisp for CPO drawings that I create. What I want to do is have draw a polyline and have the lisp hatch it and offset the pline to the outside by .5 and then give the offseted line a global width of 1 and make it red.

This is what i have so far. The hatch seems to run beore the pline though.

Anyone any ideas??

CPO.lsp

I am trying to write a lisp for CPO drawings that I create. What I want to do is have draw a polyline and have the lisp hatch it and offset the pline to the outside by .5 and then give the offseted line a global width of 1 and make it red.

 

This is what i have so far. The hatch seems to run beore the pline though.

 

Anyone any ideas??

Is this what you looking for?

~'J'~

CPO.LSP

Thanks for that Fixo. Just a few things to change if you could please? Can you make it so that the area inside the pline that is drawn is hatched (i.e. the black line) and that the offseted pline is given a global width of 1 and sent to back.

Thanks again.

Thanks for that Fixo. Just a few things to change if you could please? Can you make it so that the area inside the pline that is drawn is hatched (i.e. the black line) and that the offseted pline is given a global width of 1 and sent to back.

 

Thanks again.

Sorry for my stupidity (

I don't understand your exact task

Can you upload the picture (.jpeg or .tiff) or

better yet the sample drawing here?

I use A2008

~'J'~

Hope this helps fixo.

CPO-01.dwg

Hope this helps fixo.

Ok,

I will be back in a while in 2 hours or more

~'J'~

Hope this helps fixo.

Try another one instead

~'J'~

CPO.LSP

thanks Fixo,

When i run the lisp I get dumped back to the command line with the following text above it:

Command: cpo

._undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

: _BE

Command:

Command: AutoCAD variable setting rejected: "clayer" "CCC_CPO_Landonwer -

Outline - Black"._undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

: _END

Command:

thanks Fixo,

 

When i run the lisp I get dumped back to the command line with the following text above it:

 

Command: cpo

._undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

: _BE

Command:

Command: AutoCAD variable setting rejected: "clayer" "CCC_CPO_Landonwer -

Outline - Black"._undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

: _END

Command:

That means that this layer does not exist

I tryed lisp on your attached drawing - it worked fine

on my end

Here is a dump:

>>> Type CPO to execute

Command:

Command: cpo

._undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

: _BE

Command: ._pline

Specify start point:

Current line-width is 0.100

Specify next point or [Arc/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Command: ._offset

Current settings: Erase source=No Layer=Source OFFSETGAPTYPE=0

Specify offset distance or [Through/Erase/Layer] : 0.500000000000000

Select object to offset or [Exit/Undo] :

Specify point on side to offset or [Exit/Multiple/Undo] :

Select object to offset or [Exit/Undo] :

Command: ._pedit Select polyline or [Multiple]:

Enter an option [Open/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype

gen/Undo]: _W

Specify new width for all segments: 1.000000000000000

Enter an option [Open/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]:

Command: -hatch

Current hatch pattern: SOLID

Specify internal point or [Properties/Select objects/draW boundary/remove

Boundaries/Advanced/DRaw order/Origin/ANnotative]: S

Select objects: 1 found

Select objects:

Current hatch pattern: SOLID

Specify internal point or [Properties/Select objects/draW boundary/remove

Boundaries/Advanced/DRaw order/Origin/ANnotative]:

Command: nil._undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

: _END

~'J'~

Fixo,

Just got to try this now. This is brilliant. One thing though can you make it set the red pline to back. Apart from that it is excellent. Just wondering too if you can set the black line weight to zero. I tried to find it in the code but I'm not that familiar.

Thanks a mil.

Fixo,

Just got to try this now. This is brilliant. One thing though can you make it set the red pline to back. Apart from that it is excellent. Just wondering too if you can set the black line weight to zero. I tried to find it in the code but I'm not that familiar.

Thanks a mil.

Hi, Woodman

I've changed this lisp to your needs and

added the local defun (written by CAB) that will be create all

layers that have been used there

Hope this is a final version

~'J'~

CPO_Final_Ver.LSP

yeah but i shold have said can you bring the black outline to the front. That will be the final version.

Thanks fixo. This will get things set up very well.

yeah but i shold have said can you bring the black outline to the front. That will be the final version.

 

Thanks fixo. This will get things set up very well.

I was mistaken with these polylines

Try this one instead

~'J'~

CPO_Final_Ver.LSP

That did it Fixo. Excellent stuff. Thank you for that. It will certainly speed things up a bit.

That did it Fixo. Excellent stuff. Thank you for that. It will certainly speed things up a bit.

You're welcome

Let get your beer and relax

Cheers

~'J'~

Fixo,

I have been trying to modify this lisp you wrote for me to select a polyline instead of drawing a polyline. But I keep getting an error at the selection stage.. Could you have a look? See the red text below!

;; local defun by CAB (Charles Alan Butler)
(defun LayerMake (lyrname Color ltype)
 (if (tblsearch "LAYER" lyrname)
   (command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
   (command "._Layer" "_Make" lyrname "_Color"
            (if (or (null color)(= Color "")) "_White" Color) lyrname
            "LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
 )
)

 

(defun C:CPO1 (/ *error* ang col clr coords dwo elist midp offsetted ofpt osm p1 p2 p3 pline)
(defun *error*	(msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
    (princ "Error!")
    (princ msg)
    )
 (if osm (setvar "osmode" osm))
 (if clr (setvar "clayer" clr))
 (if col (setvar "cecolor" col))
 (if dwo (setvar "draworderctl" dwo))
 (command "._undo" "_END")
 )

 (setq osm (getvar "osmode"))  
 (setq col (getvar "cecolor"))
 (setq clr (getvar "clayer"))
 (setq dwo (getvar "draworderctl"))
 (command "._undo" "_BE")
 (setvar "osmode" 0)
 (setvar "cecolor" "bylayer")
 (LayerMake "CCC_CPO_Landonwer - Grey Hatch" "254" "Continuous")
 (LayerMake "CCC_CPO_Landonwer - Outline - Red" "1" "Continuous")
 (LayerMake "CCC_CPO_Landonwer - Outline - Black" "7" "Continuous")
(setvar "clayer" "CCC_CPO_Landonwer - Outline - Black")  
[color="red"];(command "._pline")
;(while (= 1 (logand 1 (getvar "cmdactive")))
;(command pause))
 ;(setq pline (entlast)
;elist (entget pline)

(setq pline(entsel "\nSelect a closed polyline: ")
elist (entget pline)
)[/color]
(setq elist (entmod (subst (cons 70 1)(assoc 70 elist)elist)));<--close pline
(entmod (subst (cons 43 0)(assoc 43 elist)elist));<--set line width to zero
(setvar "draworderctl" 3)  
(command "_.draworder" pline "" "_F");<--set pline's draw order to front  
(setq coords (vl-remove-if (function not)
	 (mapcar (function (lambda (x)
			     (if (= 10 (car x))(cdr x))))
		 elist))
)
(setq p3 (caddr coords)
     p1 (car coords)
     ang (angle p1 p3)
     ofpt (polar p3 ang 1.0)
     )
(setvar "clayer" "CCC_CPO_Landonwer - Outline - Red")
(command "._offset" 0.5 pline ofpt "")
 (setq offsetted (entlast)
	elist (entget offsetted)
)
(if (assoc 62 elist)
(setq elist (subst (cons 62 1)(assoc 62 elist) elist ))
(setq elist (append elist (list '(62 . 1))))
)
(entmod elist)

(command "._pedit" offsetted "_W" 1.0 "")
(command "_.draworder" offsetted "" "_B");<--set pline's draw order to back  
(setq coords (vl-remove-if (function not)
	 (mapcar (function (lambda (x)
			     (if (= 10 (car x))(cdr x))))
		 elist))
)
 (setq p2 (car coords)
midp (mapcar (function (lambda( a b)(/ (+ a b) 2)))
	     p1 p2)
)
 (setvar "clayer" "CCC_CPO_Landonwer - Grey Hatch")
 (setvar "hpname" "SOLID")
 (command "-hatch" "S" pline "" "")
 (setvar "hpname" ".")
 
 (*error* nil) 
(princ) 
)
(prompt "\n\t\t>>>\tType CPO to execute\t<<<\n")
 (princ)

This is the error I am getting:

Select a closed polyline: bad argument type: lentityp (<Entity name: 
7fffcb22b00> (102.187 195.051 0.0))._undo Current settings: Auto = On, Control 
= All, Combine = Yes, Layer = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back] 
<1>: _END
Command:
Command:

I would appreciate some help with this. Thanks.

Change :

(setq pline(entsel "\nSelect a closed polyline: ")[color=black]

[/color]

to :

[/color][/color][color=red][color=black](setq pline[/color] (car [color=black](entsel "\nSelect a closed polyline: "))

That did the trick alright. Thanks Marko. Much appreciated.

Hi Marko,

I have a modified version of that lisp that I use but I have a different problem with it:

;; local defun by CAB (Charles Alan Butler)
(defun LayerMake_LandTransfer (lyrname Color ltype)
 (if (tblsearch "LAYER" lyrname)
   (command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
   (command "._Layer" "_Make" lyrname "_Color"
            (if (or (null color)(= Color "")) "_White" Color) lyrname
            "LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
 )
)


(defun C:LandTransfer1 (/ *error* ang col clr coords dwo elist midp offsetted ofpt osm p1 p2 p3 pline a b c SUCE SUOM SUSM SUAB SUAD SUCL SUCR)
(setq dcl_id (load_dialog "LandTransfer.dcl"))
    (if (not (new_dialog "LandTransfer" dcl_id))
 (exit)
    );if

(if *name1*
   (set_tile "name" *name1*)
   (set_tile "name" "Default")
 )

(setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))

(action_tile "name" "(setq *name1* $value)")

(start_dialog)
(unload_dialog dcl_id)

 (setq a (strcat "CCC_LandTransfer_"*name1*"_Grey_Hatch")
         b (strcat "CCC_LandTransfer_"*name1*"_Outline_Red")
         c (strcat "CCC_LandTransfer_"*name1*"_Outline_Black"))

(command "_-layer" "_N" a "_C" "254" a "" )
(command "_-layer" "_N" b "_C" "1" b "" )
(command "_-layer" "_N" c "_C" "7" c "_LW" "0" c "" )

(defun *error*	(msg)
 (if
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
    (princ "Error!")
    (princ msg)
    )
 (if osm (setvar "osmode" osm))
 (if clr (setvar "clayer" clr))
 (if col (setvar "cecolor" col))
 (if dwo (setvar "draworderctl" dwo))
 (command "._undo" "_END")
 )

(initget "D S")
(setq option (getkword "\nChoose to Draw a land parcel or Select line to convert to a land parcel: [D/S]: "))
(cond     ((= option "D")(LT_draw))
((= option "S")(LT_select))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LT_select ()
;(setq pline(entsel "\nSelect a closed polyline: "))
(setq pline (car(entsel "\nSelect a closed polyline: "))
elist (entget pline)
)
[color="red"](command "_change" pline "" "p" "layer" c "color" "bylayer" "")[/color]
(yellow_resume)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LT_draw ()
(Alert "Remember to draw the plot outline in an ANTI-CLOCKWISE direction.")
(princ "\nDraw an outline for the land parcel area: ")
(setvar "cecolor" "1") 
(setvar "plinegen" 1)
(command "._pline")
(while (= 1 (logand 1 (getvar "cmdactive")))
(command pause))
(setq pline (entlast)
elist (entget pline)
)
(setvar "cecolor" "Bylayer")  
(command "_.draworder" pline "" "_F");<--set pline's draw order to front  
[color="red"](command "_change" pline "" "p" "Layer" c "color" "Bylayer" "")[/color]
(yellow_resume)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun yellow_resume ()
[color="red"](command "_change" pline "" "p" "layer" c "color" "bylayer" "")[/color]
(setq elist (entmod (subst (cons 70 1)(assoc 70 elist)elist)));<--close pline
(entmod (subst (cons 43 0)(assoc 43 elist)elist));<--set line width to zero
(setvar "draworderctl" 3)  
(command "_.draworder" pline "" "_F");<--set pline's draw order to front  
(setq coords (vl-remove-if (function not)
	 (mapcar (function (lambda (x)
			     (if (= 10 (car x))(cdr x))))
		 elist))
)
(setq p3 (caddr coords)
     p1 (car coords)
     ang (angle p1 p3)
     ofpt (polar p3 ang 1.0)
     )
(setvar "clayer" b)
(command "._offset" 0.5 pline ofpt "")
 (setq offsetted (entlast)
	elist (entget offsetted)
)
[color="red"](command "_change" offsetted "" "p" "layer" b "color" "bylayer" "")[/color]
(if (assoc 62 elist)
(setq elist (subst (cons 62 1)(assoc 62 elist) elist ))
(setq elist (append elist (list '(62 . 1))))
)
(entmod elist)

(command "._pedit" offsetted "_W" 1.0 "")
(command "_.draworder" offsetted "" "_B");<--set pline's draw order to back  
(setq coords (vl-remove-if (function not)
	 (mapcar (function (lambda (x)
			     (if (= 10 (car x))(cdr x))))
		 elist))
)
 (setq p2 (car coords)
midp (mapcar (function (lambda( a b)(/ (+ a b) 2)))
	     p1 p2)
)
 (setvar "clayer" a)
 (setvar "hpname" "SOLID")
 (command "-hatch" "S" pline "" "")
 ;(while (> (getvar "cmdactive") 0)
   ;(command "\\") ;<- The Pause symbol will not pause the command. Backslash used instead. 
 
 (setvar "hpname" ".")

 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"    SUCR)


(princ) 
)

I am trying to change the properties of the entities held in pline and offsetted but it doesn't work. Can you spot my mistake?

I found the problem. I was just getting ahead of myself and doing it too early. Don't quite understand why but the result is the thing that matters.