(vlax-for layout (vla-get-layouts(vla-get-ActiveDocument (vlax-get-acad-object)))
(setq ss5(ssget "_X" '((0 . "ELLIPSE")))
(setq ss3(ssget "_X" '((0 . "CIRCLE")(-4 . "<=")(40 . 2.0)))
(setq ss (ssget "_X" '((8 . "Geometry_0"))))
(defun C:polylinedxf
(/ *error* *esel *pcn *poly *hatch *ed cmde ent data typ P1 P2 P3 parpt
eq42 cl I1 S1 R1 S2 I2 tj tj2 R2 thov R3 twov E1 tcont E2 tlist tbang pdm)
; Initial-capital variables are for Point/Integer/String/Real/Entity, to lessen quantity of
; variable names; most used in more than one section, sometimes for different purposes
;
(defun *esel (); Entity SELection by User [verb-noun operation or multiple pre-selected objects]
(while
(not (setq ent (car (entsel "\nSelect object: "))))
(prompt "\nNothing selected:")
); while
); defun - *esel
;
(defun *pcn (); = Prompt Command Name [display what command was invoked, without double first prompt]
; when command name is same as object type or Polyline sub-type
(prompt
(strcat
"\n"
(cond
(S2 (strcase S2))
; LWPolyline, Leader, PolygonMesh, Region, 3Dsolid, Body subtypes, Divide/Measure for Point
(typ); none-of-the-above
); cond
" "
); strcat
); prompt
); defun - *pcn
;
(defun *poly (); shared between LWPolyline & 2D Polyline types
(initget "PLine Rectangle POlygon Donut Cloud Boundary Sketch")
(setq
S2
(getkword
(strcat
"\nPolyline Type [PLine/Rectangle/POlygon/Donut/Cloud/Boundary/Sketch] <"
S1
">: "
); strcat
); getkword
S2 (cond (S2) (S1)); use User entry, or default for Enter
); setq
(cond; variety of Polyline
((= S2 "Rectangle")
(C:Rectangledxf)
); Rectangle variety
((= S2 "POlygon")
(setvar 'polysides (if (> I1 2) I1 4))
(setvar 'cmdecho cmde)
(command "_.polygon")
(while (> (getvar 'cmdactive) 0) (command pause))
(vlax-put (vlax-ename->vla-object (entlast)) 'ConstantWidth (getvar 'plinewid))
; Polygon doesn't honor width -- assign current [selected item's] width to new Polygon
); POlygon variety
((= S2 "Donut")
(setq R1; donut diameter at centerline
(distance (vlax-curve-getStartPoint ent) (vlax-curve-getPointAtParam ent 1))
); setq
(setvar 'donutid (- R1 (getvar 'plinewid)))
(setvar 'donutod (+ R1 (getvar 'plinewid)))
(*pcn)
(command "_.donut")
); Donut variety
((= S2 "Cloud")
(prompt "\nREVCLOUD ")
(if (= S1 "Cloud"); as determined for default offering
(progn ; then
(setq R1 (distance (vlax-curve-getStartPoint ent) (vlax-curve-getPointAtParam ent 1)))
; arc min/max lengths calculated from data; adjust multipliers as desired
(command "_.revcloud" "_arc" (* R1 0.9) (* R1 1.1))
); progn
(command "_.revcloud"); else - Cloud option chosen from other kind of selected Pline
); if
); Revcloud variety
((= S2 "Boundary")
(setvar 'hpbound 1)
(*pcn)
(command "_.boundary")
); Boundary variety
((= S2 "Sketch")
(setvar 'skpoly 1); Polyline variety
(*pcn)
(command "_.sketch")
); Sketch variety
(T (prompt "\nPLINE ") (C:POLYLINEDXF-STEP2)); ordinary-PLine variety
); cond - variety of LWPoly
); defun - *poly
;
(defun *ed (dxf); = Entity Data value associated with DXF code number
(cdr (assoc dxf data))
); defun - *ed
;
(cond ; OBJECT SELECTION
( (and
(setq ss (ssget "_I")); something pre-selected
(= (sslength ss) 1); only one object
); and
(setq ent (ssname ss 0))
); first condition [single pre-selected object]
( (ssget "_I"); more than one object selected
(sssetfirst nil); un-select multiple objects
(*esel); User select
); second condition
((*esel)); User select [nothing pre-selected]
); cond
;
(setq
data (entget ent)
typ (*ed 0)
); setq
; Warning & reset recommendation if any overrides not Bylayer or default:
(cond; begin OVERARCHING TEST for each object type
;
((wcmatch typ
"LINE,XLINE,RAY,SOLID,3DFACE,ARC,CIRCLE,ELLIPSE,SPLINE,IMAGE,WIPEOUT,TOLERANCE")
(*pcn)
(command (strcat "_." typ))
); CATCH-ALL condition for object types whose command names are the same as their 'typ' values,
; and which don't need any other information extracted to set variables, nor have other complications
;;;;; pull IMAGE out and offer SUPERHATCH option, perhaps only if part of a Group?
;;;;; pull SOLID,3DFACE,WIPEOUT out and offer TEXTMASK option?
;
((= typ "LWPOLYLINE")
(if (= (getvar 'plinetype) 0) (setvar 'plinetype 2))
; in case set at 0 [old-style "heavy" 2D type]; value of 1 can remain [new ones still lightweight];
; assumes no desire to return it to 0 - add that resetting/option/recommendation, if desired
(if (assoc 43 data); has global width
(setvar 'plinewid (*ed 43)); then - match it
(setvar 'plinewid 0); else - remove current width if non-zero
); if
(defun parpt (par); find Point at Parameter for Polyline type tests
(vlax-curve-getPointAtParam ent par)
); defun - parpt
(defun eq42 (val / pdata); find whether *all* bulge factors [(assoc 42) entries] have specified value
(setq pdata data)
(while (equal (cdr (assoc 42 pdata)) val 1e-6); can be + or -
(setq pdata (cdr (member (assoc 42 pdata) pdata))); remainder after this 42 entry
); while
(not (assoc 42 pdata)); returns T if they were all equal [none left]
); defun - eq42
(setq
cl (vlax-curve-isClosed ent)
I1 (*ed 90); number of vertices for type tests & to set 'polysides
S1 ; LWPolyline-making command default
(cond
( (and
(= I1 4)
cl
(assoc 43 data); global width
(eq42 0.0); all straight-line segments
(equal (distance (parpt 0) (parpt 1)) (distance (parpt 2) (parpt 3)) 1e-8); opposite sides equal lengths
(equal (distance (parpt 1) (parpt 2)) (distance (parpt 3) (parpt 0)) 1e-8)
(equal (rem (abs (- (angle (parpt 0) (parpt 1)) (angle (parpt 1) (parpt 2)))) pi) (/ pi 2) 1e-8)
; right angle first corner
); and
"Rectangle"
); Rectangle condition
;;;;; Identifies only four-sided square-cornered Rectangles; Rectangle command has options independent
;;;;; of similar options for general drawing: [Chamfer/Elevation/Fillet/Thickness/Width].
;;;;; Polyline with 8 vertices, 2nd & 6th segments same length, 4th & 8th segments same length, odd-numbered
;;;;; ones all same length, could be Rectangle with Fillet/Chamfer option; if odd-numbered segments have
;;;;; (42 . 0.414214), Fillet [90-degree arc bulge factor]; if (eq42 0.0), Chamfer.
;;;;; ***Don't know where those options are stored, or how to set them as defaults programmatically.***
( (and
(> I1 2)
cl
(member '(43 . 0.0) data); global width = 0
(eq42 0.0); all straight-line segments
(equal ; first two and last two segments, at least, all same length
(setq R1 (distance (parpt 0) (parpt 1))); first segment length
(distance (parpt 1) (parpt 2)); second
1e-8
); equal
(equal (distance (parpt (- I1 2)) (parpt (1- I1))) R1 1e-8); next-to-last
(equal (distance (parpt (1- I1)) (parpt 0)) R1 1e-8); last
); and
"POlygon"
); POlygon condition [does not check for equal angles]
( (and
(= I1 2)
cl
(assoc 43 data); global width
(or (eq42 1.0) (eq42 -1.0))
; both full-semi-circle arc segments in same direction, CCW or CW
); and
"Donut"
); Donut condition
( (and
(assoc 43 data); global width
(or
(and
cl
(or (eq42 0.520567) (eq42 -0.520567)); all Revcloud-type arc segments
); and
(and
(not cl)
(setq data (reverse (cddr (reverse data))))
; removes last (42) entry, which is 0 for open Revclouds. Then:
(or (eq42 0.520567) (eq42 -0.520567)); all Revcloud-type remaining
); and
); or
); and
"Cloud"
); Cloud condition
("PLine"); none of the above [no default determination for Boundary or Sketch]
); cond & S1
); setq
(*poly); subroutine shared with 2D Polyline type
); cond - LWPoly object type
;
((= typ "POLYLINE")
(setq S2 (substr (cdr (assoc 100 (reverse data))) 5))
; later 100 value minus "AcDb" prefix
(cond
((= S2 "3dPolyline") (prompt "\n3DPOLY ") (command "_.3dpoly"))
((= S2 "2dPolyline")
(initget "Heavy Lightweight")
(if
(=
(getkword
"\nMatch heavy 2D type (other than for Rectangle/Cloud), or use Lightweight type? [H/L] <L>: "
)
"Heavy"
); =
(progn; then - old-style "heavy" 2D type
(setvar 'plinetype 0)
(alert "Recommend resetting the PLINETYPE System\nVariable to 1 or 2 when finished.")
; but doesn't save it and reset it, in case User needs to make more than one of them
); progn
(if (= (getvar 'plinetype) 0) (setvar 'plinetype 2)); else
; in case it was set at 0 [old-style "heavy" 2D type]; keep value if 1 [new ones still lightweight];
; assumes no desire to return it to 0 - add that resetting/option/recommendation, if desired
); if
(setq S1 "PLine"); to offer as default in (*poly)
(*poly); subroutine shared with LWPolyline type
); second condition - 2D Polyline type
((= S2 "PolygonMesh"); [couldn't find a way to differentiate types from entity data]
(initget "3D 3DMesh Pface REvsurf RUlesurf Tabsurf")
(setq S2 (getkword
"\nPolygon Mesh command [3D/3DMesh/Pface/REvsurf/RUlesurf/Tabsurf] <3D>: "))
(if (member S2 '(nil "3D")); user hit Enter or typed 3D
(progn (load "3D") (C:3d)); then [loads in case not used before]
(progn
(*pcn)
(command (strcat "_." S2)); else - other entered option
); progn
); if
); third condition - mesh types
); cond - variety of Polyline
); 3D/heavy 2D Polyline object type
;
); cond - OVERARCHING TEST for each object type
;
); defun - C:polylinedxf
(prompt "\nType polylinedxf to Make More the same as an existing object.")
; MakeMore.lsp
----------------------------------------------
(defun c:rectangledxf ()
(setq ss4(ssget "_X" '((0 . "LWPOLYLINE")))
);end setq
(setq ss3(ssget "_X" '((0 . "CIRCLE")(-4 . "<=")(40 . 2.0)))
);end setq
(command "._change" ss4 "" "p" "LA" "ProcPart_31" "")
(command "._change" ss3 "" "p" "LA" "V_DrillFF_3" "")
(command "_.scale" "all" "" "0,0" "25.4")
(if (and (setq d (abs 3))
(setq d (/ d 2.))
(setq ss (ssget "_X" '((8 . "V_DrillFF_3"))))
)
(repeat (setq i (sslength ss))
(setpropertyvalue (ssname ss (setq i (1- i))) "Radius" d)))
(command "._zoom" "e")
);end rectangledxf
-------------------------------------------------
(defun c:polylinedxf-step2 ()
(vlax-for layout (vla-get-layouts(vla-get-ActiveDocument (vlax-get-acad-object)))
(if (/= (vla-get-name layout) "Model")(vla-delete layout)))
(setq ss5(ssget "_X" '((0 . "LWPOLYLINE")))
);end setq
(setq ss3(ssget "_X" '((0 . "CIRCLE")(-4 . "<=")(40 . 2.0)))
);end setq
(command "._change" ss5 "" "p" "LA" "Geometry_0" "")
(command "._change" ss3 "" "p" "LA" "V_DrillFF_3" "")
(command "_.scale" "all" "" "0,0" "25.4")
(if (and (setq d (abs 3))
(setq d (/ d 2.))
(setq ss (ssget "_X" '((8 . "V_DrillFF_3"))))
)
(repeat (setq i (sslength ss))
(setpropertyvalue (ssname ss (setq i (1- i))) "Radius" d)))
(defun obb (ent); = Object's Bounding Box corners
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
(setq
oLL (vlax-safearray->list minpt); Object's Lower Left
oUR (vlax-safearray->list maxpt); Object's Upper Right
); setq
); defun -- obb
(vl-load-com)
;;(prompt "\nTo draw the Smallest Rectangle around them,")
(setq ss (ssget "_X" '((8 . "Geometry_0"))))
(obb (ssname ss 0))
(setq LL oLL UR oUR); initial overall LL & UR [of first object]
(ssdel (ssname ss 0) ss)
(repeat (sslength ss)
(obb (ssname ss 0))
(setq
LL (mapcar 'min oLL LL); least of each component
UR (mapcar 'max oUR UR); greatest of each component
); setq
(ssdel (ssname ss 0) ss)
); repeat
(command "_.rectangle" "_none" LL "_none" UR)
(princ)
(setq ss2(ssget "_L")
);end setq
(command "._change" ss2 "" "p" "LA" "ProcPart_31" "")
(command "._zoom" "e")
);end polylinedxf-step2
-----------------------------
